1 |
|
1 |
SUBROUTINE dynetat0(fichnom,vcov,ucov,teta,q,masse,ps,phis,time) |
2 |
|
|
! |
3 |
|
|
!------------------------------------------------------------------------------- |
4 |
|
|
! Authors: P. Le Van , L.Fairhead |
5 |
|
|
!------------------------------------------------------------------------------- |
6 |
|
|
! Purpose: Initial state reading. |
7 |
|
|
!------------------------------------------------------------------------------- |
8 |
|
|
USE infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName |
9 |
|
|
USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str |
10 |
|
|
USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_INQ_VARID, & |
11 |
|
|
NF90_CLOSE, NF90_GET_VAR, NF90_NoErr |
12 |
|
|
USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey |
13 |
|
|
USE control_mod, ONLY: planet_type |
14 |
|
|
USE assert_eq_m, ONLY: assert_eq |
15 |
|
|
USE comvert_mod, ONLY: pa,preff |
16 |
|
|
USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad |
17 |
|
|
USE logic_mod, ONLY: fxyhypb, ysinus |
18 |
|
|
USE serre_mod, ONLY: clon, clat, grossismx, grossismy |
19 |
|
|
USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time |
20 |
|
|
USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 |
21 |
|
|
|
22 |
|
|
IMPLICIT NONE |
23 |
|
|
include "dimensions.h" |
24 |
|
|
include "paramet.h" |
25 |
|
|
include "comgeom2.h" |
26 |
|
|
include "description.h" |
27 |
|
|
include "iniprint.h" |
28 |
|
|
!=============================================================================== |
29 |
|
|
! Arguments: |
30 |
|
|
CHARACTER(LEN=*), INTENT(IN) :: fichnom !--- FILE NAME |
31 |
|
|
REAL, INTENT(OUT) :: vcov(iip1,jjm, llm) !--- V COVARIANT WIND |
32 |
|
|
REAL, INTENT(OUT) :: ucov(iip1,jjp1,llm) !--- U COVARIANT WIND |
33 |
|
|
REAL, INTENT(OUT) :: teta(iip1,jjp1,llm) !--- POTENTIAL TEMP. |
34 |
|
|
REAL, INTENT(OUT) :: q(iip1,jjp1,llm,nqtot) !--- TRACERS |
35 |
|
|
REAL, INTENT(OUT) :: masse(iip1,jjp1,llm) !--- MASS PER CELL |
36 |
|
|
REAL, INTENT(OUT) :: ps(iip1,jjp1) !--- GROUND PRESSURE |
37 |
|
|
REAL, INTENT(OUT) :: phis(iip1,jjp1) !--- GEOPOTENTIAL |
38 |
|
|
!=============================================================================== |
39 |
|
|
! Local variables: |
40 |
|
|
CHARACTER(LEN=maxlen) :: mesg, var, modname, oldVar |
41 |
|
|
INTEGER, PARAMETER :: length=100 |
42 |
|
|
INTEGER :: iq, fID, vID, idecal, iqParent, iName, iZone, iPhase |
43 |
|
|
REAL :: time, tnat, alpha_ideal, tab_cntrl(length) !--- RUN PARAMS TABLE |
44 |
|
|
LOGICAL :: lSkip, ll |
45 |
|
|
!------------------------------------------------------------------------------- |
46 |
|
1 |
modname="dynetat0" |
47 |
|
|
|
48 |
|
|
!--- Initial state file opening |
49 |
|
1 |
var=fichnom |
50 |
|
1 |
CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var) |
51 |
|
1 |
CALL get_var1("controle",tab_cntrl) |
52 |
|
|
|
53 |
|
|
!!! AS: idecal is a hack to be able to read planeto starts... |
54 |
|
|
!!! .... while keeping everything OK for LMDZ EARTH |
55 |
✗✓ |
1 |
IF(planet_type=="generic") THEN |
56 |
|
|
CALL msg('NOTE NOTE NOTE : Planeto-like start files', modname) |
57 |
|
|
idecal = 4 |
58 |
|
|
annee_ref = 2000 |
59 |
|
|
ELSE |
60 |
|
1 |
CALL msg('NOTE NOTE NOTE : Earth-like start files', modname) |
61 |
|
|
idecal = 5 |
62 |
|
1 |
annee_ref = tab_cntrl(5) |
63 |
|
|
END IF |
64 |
|
1 |
im = tab_cntrl(1) |
65 |
|
1 |
jm = tab_cntrl(2) |
66 |
|
1 |
lllm = tab_cntrl(3) |
67 |
|
1 |
day_ref = tab_cntrl(4) |
68 |
|
1 |
rad = tab_cntrl(idecal+1) |
69 |
|
1 |
omeg = tab_cntrl(idecal+2) |
70 |
|
1 |
g = tab_cntrl(idecal+3) |
71 |
|
1 |
cpp = tab_cntrl(idecal+4) |
72 |
|
1 |
kappa = tab_cntrl(idecal+5) |
73 |
|
1 |
daysec = tab_cntrl(idecal+6) |
74 |
|
1 |
dtvr = tab_cntrl(idecal+7) |
75 |
|
1 |
etot0 = tab_cntrl(idecal+8) |
76 |
|
1 |
ptot0 = tab_cntrl(idecal+9) |
77 |
|
1 |
ztot0 = tab_cntrl(idecal+10) |
78 |
|
1 |
stot0 = tab_cntrl(idecal+11) |
79 |
|
1 |
ang0 = tab_cntrl(idecal+12) |
80 |
|
1 |
pa = tab_cntrl(idecal+13) |
81 |
|
1 |
preff = tab_cntrl(idecal+14) |
82 |
|
|
! |
83 |
|
1 |
clon = tab_cntrl(idecal+15) |
84 |
|
1 |
clat = tab_cntrl(idecal+16) |
85 |
|
1 |
grossismx = tab_cntrl(idecal+17) |
86 |
|
1 |
grossismy = tab_cntrl(idecal+18) |
87 |
|
|
! |
88 |
✓✗ |
1 |
IF ( tab_cntrl(idecal+19)==1. ) THEN |
89 |
|
1 |
fxyhypb = .TRUE. |
90 |
|
|
! dzoomx = tab_cntrl(25) |
91 |
|
|
! dzoomy = tab_cntrl(26) |
92 |
|
|
! taux = tab_cntrl(28) |
93 |
|
|
! tauy = tab_cntrl(29) |
94 |
|
|
ELSE |
95 |
|
|
fxyhypb = .FALSE. |
96 |
|
|
ysinus = tab_cntrl(idecal+22)==1. |
97 |
|
|
END IF |
98 |
|
|
|
99 |
|
1 |
day_ini = tab_cntrl(30) |
100 |
|
1 |
itau_dyn = tab_cntrl(31) |
101 |
|
1 |
start_time = tab_cntrl(32) |
102 |
|
|
|
103 |
|
|
!------------------------------------------------------------------------------- |
104 |
✓✓✓✗
|
6 |
CALL msg('rad, omeg, g, cpp, kappa = '//TRIM(strStack(real2str([rad,omeg,g,cpp,kappa]))), modname) |
105 |
|
1 |
CALL check_dim(im,iim,'im','im') |
106 |
|
1 |
CALL check_dim(jm,jjm,'jm','jm') |
107 |
|
1 |
CALL check_dim(lllm,llm,'lm','lllm') |
108 |
|
1 |
CALL get_var1("rlonu",rlonu) |
109 |
|
1 |
CALL get_var1("rlatu",rlatu) |
110 |
|
1 |
CALL get_var1("rlonv",rlonv) |
111 |
|
1 |
CALL get_var1("rlatv",rlatv) |
112 |
|
1 |
CALL get_var2("cu" ,cu) |
113 |
|
1 |
CALL get_var2("cv" ,cv) |
114 |
|
1 |
CALL get_var2("aire" ,aire) |
115 |
|
1 |
var="temps" |
116 |
✗✓ |
1 |
IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN |
117 |
|
|
CALL msg('missing field <temps> ; trying with <Time>', modname) |
118 |
|
|
var="Time" |
119 |
|
|
CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) |
120 |
|
|
END IF |
121 |
|
1 |
CALL err(NF90_GET_VAR(fID,vID,time),"get",var) |
122 |
|
1 |
CALL get_var2("phisinit",phis) |
123 |
|
1 |
CALL get_var3("ucov",ucov) |
124 |
|
1 |
CALL get_var3("vcov",vcov) |
125 |
|
1 |
CALL get_var3("teta",teta) |
126 |
|
1 |
CALL get_var3("masse",masse) |
127 |
|
1 |
CALL get_var2("ps",ps) |
128 |
|
|
|
129 |
|
|
!--- Tracers |
130 |
|
|
ll=.FALSE. |
131 |
|
|
#ifdef REPROBUS |
132 |
|
|
ll = NF90_INQ_VARID(fID, 'HNO3tot', vID) /= NF90_NoErr !--- DETECT OLD REPRO start.nc FILE |
133 |
|
|
#endif |
134 |
✓✓ |
6 |
DO iq=1,nqtot |
135 |
|
5 |
var = tracers(iq)%name |
136 |
|
5 |
oldVar = new2oldH2O(var) |
137 |
|
|
lSkip = ll .AND. var == 'HNO3' !--- FORCE "HNO3_g" READING FOR "HNO3" |
138 |
|
|
#ifdef REPROBUS |
139 |
|
|
ix = strIdx(newHNO3, var); IF(ix /= 0) oldVar = oldHNO3(ix) !--- REPROBUS HNO3 exceptions |
140 |
|
|
#endif |
141 |
|
|
#ifdef INCA |
142 |
|
|
IF(var == 'O3') oldVar = 'OX' !--- DEAL WITH INCA OZONE EXCEPTION |
143 |
|
|
#endif |
144 |
|
|
!-------------------------------------------------------------------------------------------------------------------------- |
145 |
✓✓ |
6 |
IF(NF90_INQ_VARID(fID, var, vID) == NF90_NoErr .AND. .NOT.lSkip) THEN !=== REGULAR CASE: AVAILABLE VARIABLE |
146 |
|
2 |
CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var) |
147 |
|
|
!-------------------------------------------------------------------------------------------------------------------------- |
148 |
✓✗ |
3 |
ELSE IF(NF90_INQ_VARID(fID, oldVar, vID) == NF90_NoErr) THEN !=== TRY WITH ALTERNATE NAME |
149 |
✓✗✓✗
|
3 |
CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to <'//TRIM(oldVar)//'>', modname) |
150 |
|
3 |
CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",oldVar) |
151 |
|
|
!-------------------------------------------------------------------------------------------------------------------------- |
152 |
|
|
ELSE IF(tracers(iq)%iso_iGroup == iH2O .AND. niso > 0) THEN !=== WATER ISOTOPES |
153 |
|
|
iName = tracers(iq)%iso_iName |
154 |
|
|
iPhase = tracers(iq)%iso_iPhase |
155 |
|
|
iqParent = tracers(iq)%iqParent |
156 |
|
|
IF(tracers(iq)%iso_iZone == 0) THEN |
157 |
|
|
IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) & |
158 |
|
|
CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1) |
159 |
|
|
CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized with a simplified Rayleigh distillation law.', modname) |
160 |
|
|
q(:,:,:,iq) = q(:,:,:,iqParent)*tnat*(q(:,:,:,iqParent)/30.e-3)**(alpha_ideal-1.) |
161 |
|
|
ELSE |
162 |
|
|
CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to its parent isotope concentration.', modname) |
163 |
|
|
! Camille 9 mars 2023: attention!! seuls les tags qui correspondent à |
164 |
|
|
! izone=izone_init (définie dans isotrac_mod) sont initialisés comme |
165 |
|
|
! les parents. Sinon, c'est nul. |
166 |
|
|
! j'ai fait ça en attendant, mais il faudrait initialiser proprement en |
167 |
|
|
! remplacant 1 par izone_init dans la ligne qui suit. |
168 |
|
|
IF(tracers(iq)%iso_iZone == 1) THEN |
169 |
|
|
q(:,:,:,iq) = q(:,:,:,iqIsoPha(iName,iPhase)) |
170 |
|
|
ELSE |
171 |
|
|
q(:,:,:,iq) = 0. |
172 |
|
|
END IF |
173 |
|
|
END IF |
174 |
|
|
!-------------------------------------------------------------------------------------------------------------------------- |
175 |
|
|
ELSE !=== MISSING: SET TO 0 |
176 |
|
|
CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to zero', modname) |
177 |
|
|
q(:,:,:,iq)=0. |
178 |
|
|
!-------------------------------------------------------------------------------------------------------------------------- |
179 |
|
|
END IF |
180 |
|
|
END DO |
181 |
|
|
|
182 |
|
1 |
CALL err(NF90_CLOSE(fID),"close",fichnom) |
183 |
|
1 |
day_ini=day_ini+INT(time) |
184 |
✓✗ |
1 |
time=time-INT(time) |
185 |
|
|
|
186 |
|
|
|
187 |
|
|
CONTAINS |
188 |
|
|
|
189 |
|
|
|
190 |
|
3 |
SUBROUTINE check_dim(n1,n2,str1,str2) |
191 |
|
|
INTEGER, INTENT(IN) :: n1, n2 |
192 |
|
|
CHARACTER(LEN=*), INTENT(IN) :: str1, str2 |
193 |
|
|
CHARACTER(LEN=maxlen) :: s1, s2 |
194 |
✗✓ |
3 |
IF(n1/=n2) CALL abort_gcm(TRIM(modname), 'value of "'//TRIM(str1)//'" = '//TRIM(int2str(n1))// & |
195 |
|
|
' read in starting file differs from gcm value of "'//TRIM(str2)//'" = '//TRIM(int2str(n2)), 1) |
196 |
|
3 |
END SUBROUTINE check_dim |
197 |
|
|
|
198 |
|
|
|
199 |
✗✓ |
5 |
SUBROUTINE get_var1(var,v) |
200 |
|
|
CHARACTER(LEN=*), INTENT(IN) :: var |
201 |
|
|
REAL, INTENT(OUT) :: v(:) |
202 |
|
5 |
CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) |
203 |
|
5 |
CALL err(NF90_GET_VAR(fID,vID,v),"get",var) |
204 |
|
5 |
END SUBROUTINE get_var1 |
205 |
|
|
|
206 |
|
|
|
207 |
✗✓ |
5 |
SUBROUTINE get_var2(var,v) |
208 |
|
|
CHARACTER(LEN=*), INTENT(IN) :: var |
209 |
|
|
REAL, INTENT(OUT) :: v(:,:) |
210 |
|
5 |
CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) |
211 |
|
5 |
CALL err(NF90_GET_VAR(fID,vID,v),"get",var) |
212 |
|
5 |
END SUBROUTINE get_var2 |
213 |
|
|
|
214 |
|
|
|
215 |
✗✓ |
4 |
SUBROUTINE get_var3(var,v) |
216 |
|
|
CHARACTER(LEN=*), INTENT(IN) :: var |
217 |
|
|
REAL, INTENT(OUT) :: v(:,:,:) |
218 |
|
4 |
CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) |
219 |
|
4 |
CALL err(NF90_GET_VAR(fID,vID,v),"get",var) |
220 |
|
4 |
END SUBROUTINE get_var3 |
221 |
|
|
|
222 |
|
|
|
223 |
|
36 |
SUBROUTINE err(ierr,typ,nam) |
224 |
|
|
INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE |
225 |
|
|
CHARACTER(LEN=*), INTENT(IN) :: typ !--- TYPE OF OPERATION |
226 |
|
|
CHARACTER(LEN=*), INTENT(IN) :: nam !--- FIELD/FILE NAME |
227 |
✗✓ |
36 |
IF(ierr==NF90_NoERR) RETURN |
228 |
|
|
SELECT CASE(typ) |
229 |
|
|
CASE('inq'); mesg="Field <"//TRIM(nam)//"> is missing" |
230 |
|
|
CASE('get'); mesg="Reading failed for <"//TRIM(nam)//">" |
231 |
|
|
CASE('open'); mesg="File opening failed for <"//TRIM(nam)//">" |
232 |
|
|
CASE('close'); mesg="File closing failed for <"//TRIM(nam)//">" |
233 |
|
|
END SELECT |
234 |
|
|
CALL ABORT_gcm(TRIM(modname),TRIM(mesg),ierr) |
235 |
|
|
END SUBROUTINE err |
236 |
|
|
|
237 |
|
|
END SUBROUTINE dynetat0 |