[2299] | 1 | SUBROUTINE dynetat0_loc(fichnom,vcov,ucov,teta,q,masse,ps,phis,time) |
---|
[5099] | 2 | |
---|
[2299] | 3 | !------------------------------------------------------------------------------- |
---|
| 4 | ! Authors: P. Le Van , L.Fairhead |
---|
| 5 | !------------------------------------------------------------------------------- |
---|
| 6 | ! Purpose: Initial state reading. |
---|
| 7 | !------------------------------------------------------------------------------- |
---|
| 8 | USE parallel_lmdz |
---|
[4325] | 9 | USE infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName |
---|
[4436] | 10 | USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str, strIdx |
---|
[5101] | 11 | USE netcdf, ONLY: nf90_open, nf90_nowrite, nf90_inquire_dimension, nf90_inq_varid, & |
---|
| 12 | nf90_close, nf90_get_var, nf90_inquire_variable, nf90_noerr |
---|
[4325] | 13 | USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey |
---|
[2299] | 14 | USE control_mod, ONLY: planet_type |
---|
[5113] | 15 | USE lmdz_assert_eq, ONLY: assert_eq |
---|
[2600] | 16 | USE comvert_mod, ONLY: pa,preff |
---|
[4120] | 17 | USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad |
---|
[2603] | 18 | USE logic_mod, ONLY: fxyhypb, ysinus |
---|
[2598] | 19 | USE serre_mod, ONLY: clon, clat, grossismx, grossismy |
---|
[4120] | 20 | USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time |
---|
[2622] | 21 | USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 |
---|
[5091] | 22 | USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA |
---|
[5114] | 23 | USE lmdz_description, ONLY: descript |
---|
[4120] | 24 | |
---|
[2299] | 25 | IMPLICIT NONE |
---|
| 26 | include "dimensions.h" |
---|
| 27 | include "paramet.h" |
---|
| 28 | include "comgeom.h" |
---|
| 29 | include "iniprint.h" |
---|
| 30 | !=============================================================================== |
---|
| 31 | ! Arguments: |
---|
| 32 | CHARACTER(LEN=*), INTENT(IN) :: fichnom !--- FILE NAME |
---|
| 33 | REAL, INTENT(OUT) :: vcov(ijb_v:ije_v,llm) !--- V COVARIANT WIND |
---|
| 34 | REAL, INTENT(OUT) :: ucov(ijb_u:ije_u,llm) !--- U COVARIANT WIND |
---|
| 35 | REAL, INTENT(OUT) :: teta(ijb_u:ije_u,llm) !--- POTENTIAL TEMP. |
---|
| 36 | REAL, INTENT(OUT) :: q(ijb_u:ije_u,llm,nqtot)!--- TRACERS |
---|
| 37 | REAL, INTENT(OUT) :: masse(ijb_u:ije_u,llm) !--- MASS PER CELL |
---|
| 38 | REAL, INTENT(OUT) :: ps(ijb_u:ije_u) !--- GROUND PRESSURE |
---|
| 39 | REAL, INTENT(OUT) :: phis(ijb_u:ije_u) !--- GEOPOTENTIAL |
---|
| 40 | !=============================================================================== |
---|
| 41 | ! Local variables: |
---|
[4120] | 42 | CHARACTER(LEN=maxlen) :: mesg, var, modname, oldVar |
---|
[2299] | 43 | INTEGER, PARAMETER :: length=100 |
---|
[4301] | 44 | INTEGER :: iq, fID, vID, idecal, ierr, iqParent, iName, iZone, iPhase, ix |
---|
[4984] | 45 | REAL :: time,tab_cntrl(length) !--- RUN PARAMS TABLE |
---|
| 46 | REAL :: tnat, alpha_ideal |
---|
[2299] | 47 | REAL, ALLOCATABLE :: vcov_glo(:,:),masse_glo(:,:), ps_glo(:) |
---|
| 48 | REAL, ALLOCATABLE :: ucov_glo(:,:), q_glo(:,:), phis_glo(:) |
---|
| 49 | REAL, ALLOCATABLE :: teta_glo(:,:) |
---|
[4301] | 50 | LOGICAL :: lSkip, ll |
---|
[4984] | 51 | LOGICAL,PARAMETER :: tnat1=.TRUE. |
---|
[2299] | 52 | !------------------------------------------------------------------------------- |
---|
| 53 | modname="dynetat0_loc" |
---|
[1632] | 54 | |
---|
[2299] | 55 | !--- Initial state file opening |
---|
| 56 | var=fichnom |
---|
[5100] | 57 | CALL err(nf90_open(var,nf90_nowrite,fID),"open",var) |
---|
[2299] | 58 | CALL get_var1("controle",tab_cntrl) |
---|
[1632] | 59 | |
---|
[2299] | 60 | !!! AS: idecal is a hack to be able to read planeto starts... |
---|
| 61 | !!! .... while keeping everything OK for LMDZ EARTH |
---|
| 62 | IF(planet_type=="generic") THEN |
---|
[4120] | 63 | CALL msg('NOTE NOTE NOTE : Planeto-like start files', modname) |
---|
[2299] | 64 | idecal = 4 |
---|
| 65 | annee_ref = 2000 |
---|
| 66 | ELSE |
---|
[4120] | 67 | CALL msg('NOTE NOTE NOTE : Earth-like start files', modname) |
---|
[2299] | 68 | idecal = 5 |
---|
| 69 | annee_ref = tab_cntrl(5) |
---|
| 70 | END IF |
---|
| 71 | im = tab_cntrl(1) |
---|
| 72 | jm = tab_cntrl(2) |
---|
| 73 | lllm = tab_cntrl(3) |
---|
| 74 | day_ref = tab_cntrl(4) |
---|
| 75 | rad = tab_cntrl(idecal+1) |
---|
| 76 | omeg = tab_cntrl(idecal+2) |
---|
| 77 | g = tab_cntrl(idecal+3) |
---|
| 78 | cpp = tab_cntrl(idecal+4) |
---|
| 79 | kappa = tab_cntrl(idecal+5) |
---|
| 80 | daysec = tab_cntrl(idecal+6) |
---|
| 81 | dtvr = tab_cntrl(idecal+7) |
---|
| 82 | etot0 = tab_cntrl(idecal+8) |
---|
| 83 | ptot0 = tab_cntrl(idecal+9) |
---|
| 84 | ztot0 = tab_cntrl(idecal+10) |
---|
| 85 | stot0 = tab_cntrl(idecal+11) |
---|
| 86 | ang0 = tab_cntrl(idecal+12) |
---|
| 87 | pa = tab_cntrl(idecal+13) |
---|
| 88 | preff = tab_cntrl(idecal+14) |
---|
[5099] | 89 | |
---|
[2299] | 90 | clon = tab_cntrl(idecal+15) |
---|
| 91 | clat = tab_cntrl(idecal+16) |
---|
| 92 | grossismx = tab_cntrl(idecal+17) |
---|
| 93 | grossismy = tab_cntrl(idecal+18) |
---|
[5099] | 94 | |
---|
[2299] | 95 | IF ( tab_cntrl(idecal+19)==1. ) THEN |
---|
| 96 | fxyhypb = .TRUE. |
---|
| 97 | ! dzoomx = tab_cntrl(25) |
---|
| 98 | ! dzoomy = tab_cntrl(26) |
---|
| 99 | ! taux = tab_cntrl(28) |
---|
| 100 | ! tauy = tab_cntrl(29) |
---|
| 101 | ELSE |
---|
| 102 | fxyhypb = .FALSE. |
---|
| 103 | ysinus = tab_cntrl(idecal+22)==1. |
---|
| 104 | END IF |
---|
[1632] | 105 | |
---|
[2299] | 106 | day_ini = tab_cntrl(30) |
---|
| 107 | itau_dyn = tab_cntrl(31) |
---|
[2615] | 108 | start_time = tab_cntrl(32) |
---|
[1632] | 109 | |
---|
[2299] | 110 | !------------------------------------------------------------------------------- |
---|
[4120] | 111 | CALL msg('rad, omeg, g, cpp, kappa = '//TRIM(strStack(real2str([rad,omeg,g,cpp,kappa]))), modname) |
---|
[2299] | 112 | CALL check_dim(im,iim,'im','im') |
---|
| 113 | CALL check_dim(jm,jjm,'jm','jm') |
---|
| 114 | CALL check_dim(lllm,llm,'lm','lllm') |
---|
| 115 | CALL get_var1("rlonu",rlonu) |
---|
| 116 | CALL get_var1("rlatu",rlatu) |
---|
| 117 | CALL get_var1("rlonv",rlonv) |
---|
| 118 | CALL get_var1("rlatv",rlatv) |
---|
| 119 | CALL get_var1("cu" ,cu) |
---|
| 120 | CALL get_var1("cv" ,cv) |
---|
| 121 | CALL get_var1("aire",aire) |
---|
[1632] | 122 | |
---|
[2299] | 123 | var="temps" |
---|
[5101] | 124 | IF(nf90_inq_varid(fID,var,vID)/=nf90_noerr) THEN |
---|
[4120] | 125 | CALL msg('missing field <temps> ; trying with <Time>', modname) |
---|
| 126 | var="Time" |
---|
[5101] | 127 | CALL err(nf90_inq_varid(fID,var,vID),"inq",var) |
---|
[2299] | 128 | END IF |
---|
[5099] | 129 | CALL err(nf90_get_var(fID,vID,time),"get",var) |
---|
[1632] | 130 | |
---|
[2299] | 131 | ALLOCATE(phis_glo(ip1jmp1)) |
---|
| 132 | CALL get_var1("phisinit",phis_glo) |
---|
| 133 | phis (ijb_u:ije_u) =phis_glo(ijb_u:ije_u); DEALLOCATE(phis_glo) |
---|
[1632] | 134 | |
---|
[2299] | 135 | ALLOCATE(ucov_glo(ip1jmp1,llm)) |
---|
| 136 | CALL get_var2("ucov",ucov_glo) |
---|
| 137 | ucov (ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:); DEALLOCATE(ucov_glo) |
---|
[1673] | 138 | |
---|
[2299] | 139 | ALLOCATE(vcov_glo(ip1jm,llm)) |
---|
| 140 | CALL get_var2("vcov",vcov_glo) |
---|
| 141 | vcov (ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:); DEALLOCATE(vcov_glo) |
---|
[1632] | 142 | |
---|
[2299] | 143 | ALLOCATE(teta_glo(ip1jmp1,llm)) |
---|
| 144 | CALL get_var2("teta",teta_glo) |
---|
| 145 | teta (ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:); DEALLOCATE(teta_glo) |
---|
[1632] | 146 | |
---|
[2299] | 147 | ALLOCATE(masse_glo(ip1jmp1,llm)) |
---|
| 148 | CALL get_var2("masse",masse_glo) |
---|
| 149 | masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:); DEALLOCATE(masse_glo) |
---|
| 150 | |
---|
| 151 | ALLOCATE(ps_glo(ip1jmp1)) |
---|
| 152 | CALL get_var1("ps",ps_glo) |
---|
| 153 | ps (ijb_u:ije_u) = ps_glo(ijb_u:ije_u); DEALLOCATE(ps_glo) |
---|
[1632] | 154 | |
---|
[2299] | 155 | !--- Tracers |
---|
| 156 | ALLOCATE(q_glo(ip1jmp1,llm)) |
---|
[4301] | 157 | ll = .FALSE. |
---|
[4263] | 158 | #ifdef REPROBUS |
---|
[5101] | 159 | ll = nf90_inq_varid(fID, 'HNO3tot', vID) /= nf90_noerr !--- DETECT OLD REPRO start.nc FILE |
---|
[4263] | 160 | #endif |
---|
[2299] | 161 | DO iq=1,nqtot |
---|
[4120] | 162 | var = tracers(iq)%name |
---|
[4301] | 163 | oldVar = new2oldH2O(var) |
---|
| 164 | lSkip = ll .AND. var == 'HNO3' !--- FORCE "HNO3_g" READING FOR "HNO3" |
---|
| 165 | #ifdef REPROBUS |
---|
| 166 | ix = strIdx(newHNO3, var); IF(ix /= 0) oldVar = oldHNO3(ix) !--- REPROBUS HNO3 exceptions |
---|
| 167 | #endif |
---|
[5091] | 168 | IF (CPPKEY_INCA) THEN |
---|
| 169 | IF(var == 'O3') oldVar = 'OX' !--- DEAL WITH INCA OZONE EXCEPTION |
---|
| 170 | END IF |
---|
[4265] | 171 | !-------------------------------------------------------------------------------------------------------------------------- |
---|
[5101] | 172 | IF(nf90_inq_varid(fID, var, vID) == nf90_noerr .AND. .NOT.lSkip) THEN !=== REGULAR CASE: AVAILABLE VARIABLE |
---|
[4265] | 173 | CALL get_var2(var,q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:) |
---|
| 174 | !-------------------------------------------------------------------------------------------------------------------------- |
---|
[5101] | 175 | ELSE IF(nf90_inq_varid(fID, oldVar, vID) == nf90_noerr) THEN !=== TRY WITH ALTERNATE NAME |
---|
[4265] | 176 | CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to <'//TRIM(oldVar)//'>', modname) |
---|
| 177 | CALL get_var2(oldVar, q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:) |
---|
| 178 | !-------------------------------------------------------------------------------------------------------------------------- |
---|
[4120] | 179 | ELSE IF(tracers(iq)%iso_iGroup == iH2O .AND. niso > 0) THEN !=== WATER ISOTOPES |
---|
[4143] | 180 | iName = tracers(iq)%iso_iName |
---|
[4120] | 181 | iPhase = tracers(iq)%iso_iPhase |
---|
| 182 | iqParent = tracers(iq)%iqParent |
---|
| 183 | IF(tracers(iq)%iso_iZone == 0) THEN |
---|
[4984] | 184 | if (tnat1) then |
---|
| 185 | tnat=1.0 |
---|
| 186 | alpha_ideal=1.0 |
---|
| 187 | write(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1' |
---|
| 188 | else |
---|
| 189 | IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) & |
---|
[4325] | 190 | CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1) |
---|
[4984] | 191 | endif |
---|
[4120] | 192 | CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized with a simplified Rayleigh distillation law.', modname) |
---|
[4325] | 193 | q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqParent)*tnat*(q(ijb_u:ije_u,:,iqParent)/30.e-3)**(alpha_ideal-1.) |
---|
[4490] | 194 | ! Camille 9 mars 2023: point de vigilence: initialisation incohérente |
---|
| 195 | ! avec celle de xt_ancien dans la physiq. |
---|
[4120] | 196 | ELSE |
---|
| 197 | CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to its parent isotope concentration.', modname) |
---|
[4490] | 198 | ! Camille 9 mars 2023: attention!! seuls les tags qui correspondent à |
---|
| 199 | ! izone=izone_init (définie dans isotrac_mod) sont initialisés comme |
---|
| 200 | ! les parents. Sinon, c'est nul. |
---|
| 201 | ! j'ai fait ça en attendant, mais il faudrait initialiser proprement en |
---|
| 202 | ! remplacant 1 par izone_init dans la ligne qui suit. |
---|
| 203 | IF(tracers(iq)%iso_iZone == 1) THEN |
---|
[4984] | 204 | q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase)) |
---|
[4490] | 205 | ELSE |
---|
| 206 | q(ijb_u:ije_u,:,iq) = 0. |
---|
| 207 | ENDIF |
---|
[4120] | 208 | END IF |
---|
| 209 | !-------------------------------------------------------------------------------------------------------------------------- |
---|
| 210 | ELSE !=== MISSING: SET TO 0 |
---|
| 211 | CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to zero', modname) |
---|
| 212 | q(ijb_u:ije_u,:,iq)=0. |
---|
| 213 | !-------------------------------------------------------------------------------------------------------------------------- |
---|
[2299] | 214 | END IF |
---|
| 215 | END DO |
---|
| 216 | DEALLOCATE(q_glo) |
---|
[5100] | 217 | CALL err(nf90_close(fID),"close",fichnom) |
---|
[2299] | 218 | day_ini=day_ini+INT(time) |
---|
| 219 | time=time-INT(time) |
---|
[1673] | 220 | |
---|
| 221 | |
---|
[2299] | 222 | CONTAINS |
---|
[1632] | 223 | |
---|
| 224 | |
---|
[2299] | 225 | SUBROUTINE check_dim(n1,n2,str1,str2) |
---|
| 226 | INTEGER, INTENT(IN) :: n1, n2 |
---|
| 227 | CHARACTER(LEN=*), INTENT(IN) :: str1, str2 |
---|
[4046] | 228 | CHARACTER(LEN=maxlen) :: s1, s2 |
---|
[4301] | 229 | IF(n1/=n2) CALL abort_gcm(TRIM(modname), 'value of "'//TRIM(str1)//'" = '//TRIM(int2str(n1))// & |
---|
| 230 | ' read in starting file differs from gcm value of "'//TRIM(str2)//'" = '//TRIM(int2str(n2)), 1) |
---|
[2299] | 231 | END SUBROUTINE check_dim |
---|
[1632] | 232 | |
---|
| 233 | |
---|
[2299] | 234 | SUBROUTINE get_var1(var,v) |
---|
| 235 | CHARACTER(LEN=*), INTENT(IN) :: var |
---|
| 236 | REAL, INTENT(OUT) :: v(:) |
---|
| 237 | REAL, ALLOCATABLE :: w2(:,:), w3(:,:,:) |
---|
| 238 | INTEGER :: nn(3), dids(3), k, nd, ntot |
---|
[1632] | 239 | |
---|
[5101] | 240 | CALL err(nf90_inq_varid(fID,var,vID),"inq",var) |
---|
| 241 | ierr=nf90_inquire_variable(fID,vID,ndims=nd) |
---|
[2299] | 242 | IF(nd==1) THEN |
---|
[5099] | 243 | CALL err(nf90_get_var(fID,vID,v),"get",var); RETURN |
---|
[2299] | 244 | END IF |
---|
[5101] | 245 | ierr=nf90_inquire_variable(fID,vID,dimids=dids) |
---|
[5099] | 246 | DO k=1,nd; ierr=nf90_inquire_dimension(fID,dids(k),len=nn(k)); END DO |
---|
[2299] | 247 | ntot=PRODUCT(nn(1:nd)) |
---|
| 248 | SELECT CASE(nd) |
---|
| 249 | CASE(2); ALLOCATE(w2(nn(1),nn(2))) |
---|
[5099] | 250 | CALL err(nf90_get_var(fID,vID,w2),"get",var) |
---|
[2299] | 251 | v=RESHAPE(w2,[ntot]); DEALLOCATE(w2) |
---|
| 252 | CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3))) |
---|
[5099] | 253 | CALL err(nf90_get_var(fID,vID,w3),"get",var) |
---|
[2299] | 254 | v=RESHAPE(w3,[ntot]); DEALLOCATE(w3) |
---|
| 255 | END SELECT |
---|
| 256 | END SUBROUTINE get_var1 |
---|
[1632] | 257 | |
---|
[2299] | 258 | SUBROUTINE get_var2(var,v) |
---|
| 259 | CHARACTER(LEN=*), INTENT(IN) :: var |
---|
| 260 | REAL, INTENT(OUT) :: v(:,:) |
---|
[3967] | 261 | REAL, ALLOCATABLE :: w4(:,:,:,:), w3(:,:,:) |
---|
[2299] | 262 | INTEGER :: nn(4), dids(4), k, nd |
---|
[3967] | 263 | |
---|
| 264 | |
---|
[5101] | 265 | CALL err(nf90_inq_varid(fID,var,vID),"inq",var) |
---|
| 266 | ierr=nf90_inquire_variable(fID,vID,ndims=nd) |
---|
[3967] | 267 | |
---|
| 268 | IF(nd==1) THEN |
---|
[5099] | 269 | CALL err(nf90_get_var(fID,vID,v),"get",var); RETURN |
---|
[3967] | 270 | END IF |
---|
[5101] | 271 | ierr=nf90_inquire_variable(fID,vID,dimids=dids) |
---|
[3967] | 272 | |
---|
[5099] | 273 | DO k=1,nd; ierr=nf90_inquire_dimension(fID,dids(k),len=nn(k)); END DO |
---|
[3967] | 274 | |
---|
| 275 | SELECT CASE(nd) |
---|
| 276 | CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3))) |
---|
[5099] | 277 | CALL err(nf90_get_var(fID,vID,w3),"get",var) |
---|
[3967] | 278 | v=RESHAPE(w3,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w3) |
---|
| 279 | CASE(4); ALLOCATE(w4(nn(1),nn(2),nn(3),nn(4))) |
---|
[5099] | 280 | CALL err(nf90_get_var(fID,vID,w4),"get",var) |
---|
[3967] | 281 | v=RESHAPE(w4,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w4) |
---|
| 282 | END SELECT |
---|
[2299] | 283 | END SUBROUTINE get_var2 |
---|
[1632] | 284 | |
---|
| 285 | |
---|
[2299] | 286 | SUBROUTINE err(ierr,typ,nam) |
---|
| 287 | INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE |
---|
| 288 | CHARACTER(LEN=*), INTENT(IN) :: typ !--- TYPE OF OPERATION |
---|
| 289 | CHARACTER(LEN=*), INTENT(IN) :: nam !--- FIELD/FILE NAME |
---|
[5099] | 290 | IF(ierr==nf90_noerr) RETURN |
---|
[2299] | 291 | SELECT CASE(typ) |
---|
[4120] | 292 | CASE('inq'); mesg="Field <"//TRIM(nam)//"> is missing" |
---|
| 293 | CASE('get'); mesg="Reading failed for <"//TRIM(nam)//">" |
---|
| 294 | CASE('open'); mesg="File opening failed for <"//TRIM(nam)//">" |
---|
| 295 | CASE('close'); mesg="File closing failed for <"//TRIM(nam)//">" |
---|
[2299] | 296 | END SELECT |
---|
[4120] | 297 | CALL ABORT_gcm(TRIM(modname),TRIM(mesg),ierr) |
---|
[2299] | 298 | END SUBROUTINE err |
---|
[1632] | 299 | |
---|
[2299] | 300 | END SUBROUTINE dynetat0_loc |
---|