1 | SUBROUTINE dynetat0_loc(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 parallel_lmdz |
---|
9 | USE readTracFiles_mod, ONLY: known_phases, old_phases, nphases, phases_sep |
---|
10 | USE infotrac, ONLY: nqtot, niso, tracers, iTraPha, tnat, alpha_ideal, tra |
---|
11 | USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_INQ_VARID, NF90_INQUIRE_DIMENSION, & |
---|
12 | NF90_INQUIRE, NF90_CLOSE, NF90_GET_VAR, NF90_NoErr, NF90_INQUIRE_VARIABLE |
---|
13 | USE strings_mod, ONLY: strIdx |
---|
14 | USE control_mod, ONLY: planet_type |
---|
15 | USE assert_eq_m, ONLY: assert_eq |
---|
16 | USE comvert_mod, ONLY: pa,preff |
---|
17 | USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad |
---|
18 | USE logic_mod, ONLY: fxyhypb, ysinus |
---|
19 | USE serre_mod, ONLY: clon, clat, grossismx, grossismy |
---|
20 | USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time |
---|
21 | USE ener_mod, ONLY: etot0, ptot0, ztot0, stot0, ang0 |
---|
22 | |
---|
23 | IMPLICIT NONE |
---|
24 | include "dimensions.h" |
---|
25 | include "paramet.h" |
---|
26 | include "comgeom.h" |
---|
27 | include "description.h" |
---|
28 | include "iniprint.h" |
---|
29 | !=============================================================================== |
---|
30 | ! Arguments: |
---|
31 | CHARACTER(LEN=*), INTENT(IN) :: fichnom !--- FILE NAME |
---|
32 | REAL, INTENT(OUT) :: vcov(ijb_v:ije_v,llm) !--- V COVARIANT WIND |
---|
33 | REAL, INTENT(OUT) :: ucov(ijb_u:ije_u,llm) !--- U COVARIANT WIND |
---|
34 | REAL, INTENT(OUT) :: teta(ijb_u:ije_u,llm) !--- POTENTIAL TEMP. |
---|
35 | REAL, INTENT(OUT) :: q(ijb_u:ije_u,llm,nqtot)!--- TRACERS |
---|
36 | REAL, INTENT(OUT) :: masse(ijb_u:ije_u,llm) !--- MASS PER CELL |
---|
37 | REAL, INTENT(OUT) :: ps(ijb_u:ije_u) !--- GROUND PRESSURE |
---|
38 | REAL, INTENT(OUT) :: phis(ijb_u:ije_u) !--- GEOPOTENTIAL |
---|
39 | !=============================================================================== |
---|
40 | ! Local variables: |
---|
41 | CHARACTER(LEN=256) :: sdum, var, modname, oldH2O |
---|
42 | INTEGER, PARAMETER :: length=100 |
---|
43 | INTEGER :: iq, fID, vID, idecal, ix, ip, ierr |
---|
44 | REAL :: time, tab_cntrl(length) !--- RUN PARAMS TABLE |
---|
45 | TYPE(tra), POINTER :: tr |
---|
46 | !------------------------------------------------------------------------------- |
---|
47 | modname="dynetat0_loc" |
---|
48 | |
---|
49 | !--- Initial state file opening |
---|
50 | var=fichnom |
---|
51 | CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var) |
---|
52 | CALL get_var1("controle",tab_cntrl) |
---|
53 | |
---|
54 | !!! AS: idecal is a hack to be able to read planeto starts... |
---|
55 | !!! .... while keeping everything OK for LMDZ EARTH |
---|
56 | IF(planet_type=="generic") THEN |
---|
57 | WRITE(lunout,*)'NOTE NOTE NOTE : Planeto-like start files' |
---|
58 | idecal = 4 |
---|
59 | annee_ref = 2000 |
---|
60 | ELSE |
---|
61 | WRITE(lunout,*)'NOTE NOTE NOTE : Earth-like start files' |
---|
62 | idecal = 5 |
---|
63 | annee_ref = tab_cntrl(5) |
---|
64 | END IF |
---|
65 | im = tab_cntrl(1) |
---|
66 | jm = tab_cntrl(2) |
---|
67 | lllm = tab_cntrl(3) |
---|
68 | day_ref = tab_cntrl(4) |
---|
69 | rad = tab_cntrl(idecal+1) |
---|
70 | omeg = tab_cntrl(idecal+2) |
---|
71 | g = tab_cntrl(idecal+3) |
---|
72 | cpp = tab_cntrl(idecal+4) |
---|
73 | kappa = tab_cntrl(idecal+5) |
---|
74 | daysec = tab_cntrl(idecal+6) |
---|
75 | dtvr = tab_cntrl(idecal+7) |
---|
76 | etot0 = tab_cntrl(idecal+8) |
---|
77 | ptot0 = tab_cntrl(idecal+9) |
---|
78 | ztot0 = tab_cntrl(idecal+10) |
---|
79 | stot0 = tab_cntrl(idecal+11) |
---|
80 | ang0 = tab_cntrl(idecal+12) |
---|
81 | pa = tab_cntrl(idecal+13) |
---|
82 | preff = tab_cntrl(idecal+14) |
---|
83 | ! |
---|
84 | clon = tab_cntrl(idecal+15) |
---|
85 | clat = tab_cntrl(idecal+16) |
---|
86 | grossismx = tab_cntrl(idecal+17) |
---|
87 | grossismy = tab_cntrl(idecal+18) |
---|
88 | ! |
---|
89 | IF ( tab_cntrl(idecal+19)==1. ) THEN |
---|
90 | fxyhypb = .TRUE. |
---|
91 | ! dzoomx = tab_cntrl(25) |
---|
92 | ! dzoomy = tab_cntrl(26) |
---|
93 | ! taux = tab_cntrl(28) |
---|
94 | ! tauy = tab_cntrl(29) |
---|
95 | ELSE |
---|
96 | fxyhypb = .FALSE. |
---|
97 | ysinus = tab_cntrl(idecal+22)==1. |
---|
98 | END IF |
---|
99 | |
---|
100 | day_ini = tab_cntrl(30) |
---|
101 | itau_dyn = tab_cntrl(31) |
---|
102 | start_time = tab_cntrl(32) |
---|
103 | |
---|
104 | !------------------------------------------------------------------------------- |
---|
105 | WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa |
---|
106 | CALL check_dim(im,iim,'im','im') |
---|
107 | CALL check_dim(jm,jjm,'jm','jm') |
---|
108 | CALL check_dim(lllm,llm,'lm','lllm') |
---|
109 | CALL get_var1("rlonu", rlonu) |
---|
110 | CALL get_var1("rlatu", rlatu) |
---|
111 | CALL get_var1("rlonv", rlonv) |
---|
112 | CALL get_var1("rlatv", rlatv) |
---|
113 | CALL get_var1("cu", cu) |
---|
114 | CALL get_var1("cv", cv) |
---|
115 | CALL get_var1("aire", aire) |
---|
116 | |
---|
117 | var="temps" |
---|
118 | IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN |
---|
119 | WRITE(lunout,*)TRIM(modname)//": missing field <temps>" |
---|
120 | WRITE(lunout,*)TRIM(modname)//": trying with <Time>"; var="Time" |
---|
121 | CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) |
---|
122 | END IF |
---|
123 | CALL err(NF90_GET_VAR(fID,vID,time),"get",var) |
---|
124 | CALL get_var1("phisinit", phis, ijb_u, ije_u, ip1jmp1) |
---|
125 | CALL get_var2("ucov", ucov, ijb_u, ije_u, ip1jmp1) |
---|
126 | CALL get_var2("vcov", vcov, ijb_v, ije_v, ip1jm) |
---|
127 | CALL get_var2("teta", teta, ijb_u, ije_u, ip1jmp1) |
---|
128 | CALL get_var2("masse", masse, ijb_u, ije_u, ip1jmp1) |
---|
129 | CALL get_var1("ps", ps, ijb_u, ije_u, ip1jmp1) |
---|
130 | |
---|
131 | !--- Tracers |
---|
132 | DO iq=1,nqtot |
---|
133 | tr => tracers(iq) |
---|
134 | var = tr%name |
---|
135 | ix = strIdx([('H2O'//phases_sep//known_phases(ip:ip), ip=1, nphases)], var) |
---|
136 | IF(NF90_INQ_VARID(fID, var, vID) == NF90_NoErr) THEN |
---|
137 | CALL get_var2(var, q(:,:,iq), ijb_u, ije_u, ip1jmp1) |
---|
138 | #ifdef INCA |
---|
139 | ELSE IF(NF90_INQ_VARID(fID, 'OX', vID) == NF90_NoErr .AND. var == 'O3') THEN |
---|
140 | WRITE(lunout,*)TRIM(modname)//': Tracer <O3> is missing => initialized to OX' |
---|
141 | CALL get_var2('OX', q(:,:,iq), ijb_u, ije_u, ip1jmp1) |
---|
142 | #endif |
---|
143 | ELSE IF(ix /= 0) THEN !--- Old file, water: H2Ov/l/i instead of H2O-g/-l/-s |
---|
144 | oldH2O = 'H2O'//old_phases(ix:ix) |
---|
145 | IF(NF90_INQ_VARID(fID, oldH2O, vID) == NF90_NoErr) THEN |
---|
146 | WRITE(lunout,*)TRIM(modname)//': Tracer <'//TRIM(var)//'> is missing => initialized to '//TRIM(oldH2O) |
---|
147 | CALL get_var2(oldH2O, q(:,:,iq), ijb_u, ije_u, ip1jmp1) |
---|
148 | END IF |
---|
149 | ELSE |
---|
150 | WRITE(lunout,*)TRIM(modname)//': Tracer <'//TRIM(var)//'> is missing => initialized to zero' |
---|
151 | q(ijb_u:ije_u,:,iq)=0. |
---|
152 | !--- CRisi: for isotopes, theoretical initialization using very simplified Rayleigh distillation law |
---|
153 | IF(niso > 0 .AND. tr%iso_num > 0) THEN |
---|
154 | IF(tr%iso_zon == 0) q(:,:,iq) = q(:,:,tr%iprnt) * tnat(tr%iso_num) & |
---|
155 | *(q(:,:,tr%iprnt)/30.e-3)**(alpha_ideal(tr%iso_num)-1) |
---|
156 | IF(tr%iso_zon == 1) q(:,:,iq) = q(:,:,iTraPha(tr%iso_num,tr%iso_pha)) |
---|
157 | END IF |
---|
158 | END IF |
---|
159 | END DO |
---|
160 | CALL err(NF90_CLOSE(fID),"close",fichnom) |
---|
161 | day_ini=day_ini+INT(time) |
---|
162 | time=time-INT(time) |
---|
163 | |
---|
164 | |
---|
165 | CONTAINS |
---|
166 | |
---|
167 | |
---|
168 | SUBROUTINE check_dim(n1,n2,str1,str2) |
---|
169 | INTEGER, INTENT(IN) :: n1, n2 |
---|
170 | CHARACTER(LEN=*), INTENT(IN) :: str1, str2 |
---|
171 | CHARACTER(LEN=256) :: s1, s2 |
---|
172 | IF(n1/=n2) THEN |
---|
173 | s1='value of '//TRIM(str1)//' =' |
---|
174 | s2=' read in starting file differs from parametrized '//TRIM(str2)//' =' |
---|
175 | WRITE(sdum,'(10x,a,i4,2x,a,i4)'),TRIM(s1),n1,TRIM(s2),n2 |
---|
176 | CALL ABORT_gcm(TRIM(modname),TRIM(sdum),1) |
---|
177 | END IF |
---|
178 | END SUBROUTINE check_dim |
---|
179 | |
---|
180 | |
---|
181 | SUBROUTINE get_var1(var, v, ib, ie, n_glo) |
---|
182 | CHARACTER(LEN=*), INTENT(IN) :: var |
---|
183 | REAL, INTENT(OUT) :: v(:) |
---|
184 | INTEGER, OPTIONAL, INTENT(IN) :: ib, ie, n_glo |
---|
185 | REAL, ALLOCATABLE :: w(:,:,:,:), v_glo(:) |
---|
186 | INTEGER :: nn(4), dids(4), k, nd, ntot |
---|
187 | CALL err(NF90_INQ_VARID(fID, var, vID), "inq", var) |
---|
188 | ierr = NF90_INQUIRE_VARIABLE(fID, vID, dimids=dids, ndims=nd) |
---|
189 | nn(:) = 1; DO k=1,nd; ierr = NF90_INQUIRE_DIMENSION(fID, dids(k), len=nn(k)); END DO |
---|
190 | ntot = PRODUCT(nn(1:nd)) |
---|
191 | ALLOCATE(w(nn(1), nn(2), nn(3), nn(4))) |
---|
192 | CALL err(NF90_GET_VAR(fID, vID, w), "get", var) |
---|
193 | ALLOCATE(v_glo(ntot)); v_glo=RESHAPE(w, [ntot]); DEALLOCATE(w) |
---|
194 | IF(PRESENT(n_glo).AND.PRESENT(ib).AND.PRESENT(ie)) THEN |
---|
195 | IF(ntot/=n_glo) CALL abort_gcm(TRIM(modname), 'Shape mismatch for "'//TRIM(var)//'"') |
---|
196 | v(ib:ie) = v_glo(ib:ie) |
---|
197 | ELSE |
---|
198 | v(:) = v_glo(:) |
---|
199 | END IF |
---|
200 | DEALLOCATE(v_glo) |
---|
201 | END SUBROUTINE get_var1 |
---|
202 | |
---|
203 | |
---|
204 | SUBROUTINE get_var2(var, v, ib, ie, n_glo) |
---|
205 | CHARACTER(LEN=*), INTENT(IN) :: var |
---|
206 | REAL, INTENT(OUT) :: v(:,:) |
---|
207 | INTEGER, INTENT(IN) :: ib, ie, n_glo |
---|
208 | REAL, ALLOCATABLE :: w(:,:,:,:), v_glo(:,:) |
---|
209 | INTEGER :: nn(4), dids(4), k, nd, nh, nv, tid |
---|
210 | CALL err(NF90_INQ_VARID(fID, var, vID), "inq", var) |
---|
211 | ierr = NF90_INQUIRE_VARIABLE(fID, vID, dimids=dids, ndims=nd) |
---|
212 | nn(:) = 1; DO k=1,nd; ierr = NF90_INQUIRE_DIMENSION(fID, dids(k), len=nn(k)); END DO |
---|
213 | IF(NF90_INQUIRE(fID, unlimitedDimId=tid) == NF90_NOERR) THEN |
---|
214 | nh = PRODUCT(nn(1:nd-2)); nv = nn(nd-1); nn(nd) = 1 |
---|
215 | ELSE |
---|
216 | nh = PRODUCT(nn(1:nd-1)); nv = nn(nd) |
---|
217 | END IF |
---|
218 | ALLOCATE(w(nn(1), nn(2), nn(3), nn(4))) |
---|
219 | CALL err(NF90_GET_VAR(fID, vID, w), "get", var) |
---|
220 | ALLOCATE(v_glo(nh, nv)); v_glo = RESHAPE(w, [nh, nv]); DEALLOCATE(w) |
---|
221 | IF(nh/=n_glo .OR. nv/=llm) CALL abort_gcm(TRIM(modname), 'Shape mismatch for "'//TRIM(var)//'"') |
---|
222 | v(ib:ie,:) = v_glo(ib:ie,:) |
---|
223 | DEALLOCATE(v_glo) |
---|
224 | END SUBROUTINE get_var2 |
---|
225 | |
---|
226 | |
---|
227 | SUBROUTINE err(ierr, typ, nam) |
---|
228 | INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE |
---|
229 | CHARACTER(LEN=*), INTENT(IN) :: typ !--- TYPE OF OPERATION |
---|
230 | CHARACTER(LEN=*), INTENT(IN) :: nam !--- FIELD/FILE NAME |
---|
231 | IF(ierr==NF90_NoERR) RETURN |
---|
232 | SELECT CASE(typ) |
---|
233 | CASE('inq'); sdum="Field <"//TRIM(nam)//"> is missing" |
---|
234 | CASE('get'); sdum="Reading failed for <"//TRIM(nam)//">" |
---|
235 | CASE('open'); sdum="File opening failed for <"//TRIM(nam)//">" |
---|
236 | CASE('close'); sdum="File closing failed for <"//TRIM(nam)//">" |
---|
237 | END SELECT |
---|
238 | CALL ABORT_gcm(TRIM(modname),TRIM(sdum),ierr) |
---|
239 | END SUBROUTINE err |
---|
240 | |
---|
241 | END SUBROUTINE dynetat0_loc |
---|