[2299] | 1 | SUBROUTINE dynetat0_loc(fichnom,vcov,ucov,teta,q,masse,ps,phis,time) |
---|
[1632] | 2 | ! |
---|
[2299] | 3 | !------------------------------------------------------------------------------- |
---|
| 4 | ! Authors: P. Le Van , L.Fairhead |
---|
| 5 | !------------------------------------------------------------------------------- |
---|
| 6 | ! Purpose: Initial state reading. |
---|
| 7 | !------------------------------------------------------------------------------- |
---|
| 8 | USE parallel_lmdz |
---|
| 9 | USE infotrac |
---|
| 10 | USE netcdf, ONLY: NF90_OPEN, NF90_INQUIRE_DIMENSION, NF90_INQ_VARID, & |
---|
| 11 | NF90_NOWRITE, NF90_CLOSE, NF90_INQUIRE_VARIABLE, NF90_GET_VAR, NF90_NoErr |
---|
| 12 | USE control_mod, ONLY: planet_type |
---|
| 13 | USE assert_eq_m, ONLY: assert_eq |
---|
[2600] | 14 | USE comvert_mod, ONLY: pa,preff |
---|
[2597] | 15 | USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, & |
---|
| 16 | omeg, rad |
---|
[2603] | 17 | USE logic_mod, ONLY: fxyhypb, ysinus |
---|
[2598] | 18 | USE serre_mod, ONLY: clon, clat, grossismx, grossismy |
---|
[2601] | 19 | USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn, & |
---|
| 20 | start_time,day_ini,hour_ini |
---|
[2622] | 21 | USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 |
---|
[2598] | 22 | |
---|
[2299] | 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) :: msg, var, modname |
---|
| 42 | INTEGER, PARAMETER :: length=100 |
---|
| 43 | INTEGER :: iq, fID, vID, idecal, ierr |
---|
| 44 | REAL :: time, tab_cntrl(length) !--- RUN PARAMS TABLE |
---|
| 45 | REAL, ALLOCATABLE :: vcov_glo(:,:),masse_glo(:,:), ps_glo(:) |
---|
| 46 | REAL, ALLOCATABLE :: ucov_glo(:,:), q_glo(:,:), phis_glo(:) |
---|
| 47 | REAL, ALLOCATABLE :: teta_glo(:,:) |
---|
| 48 | !------------------------------------------------------------------------------- |
---|
| 49 | modname="dynetat0_loc" |
---|
[1632] | 50 | |
---|
[2299] | 51 | !--- Initial state file opening |
---|
| 52 | var=fichnom |
---|
| 53 | CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var) |
---|
| 54 | CALL get_var1("controle",tab_cntrl) |
---|
[1632] | 55 | |
---|
[2299] | 56 | !!! AS: idecal is a hack to be able to read planeto starts... |
---|
| 57 | !!! .... while keeping everything OK for LMDZ EARTH |
---|
| 58 | IF(planet_type=="generic") THEN |
---|
| 59 | WRITE(lunout,*)'NOTE NOTE NOTE : Planeto-like start files' |
---|
| 60 | idecal = 4 |
---|
| 61 | annee_ref = 2000 |
---|
| 62 | ELSE |
---|
| 63 | WRITE(lunout,*)'NOTE NOTE NOTE : Earth-like start files' |
---|
| 64 | idecal = 5 |
---|
| 65 | annee_ref = tab_cntrl(5) |
---|
| 66 | END IF |
---|
| 67 | im = tab_cntrl(1) |
---|
| 68 | jm = tab_cntrl(2) |
---|
| 69 | lllm = tab_cntrl(3) |
---|
| 70 | day_ref = tab_cntrl(4) |
---|
| 71 | rad = tab_cntrl(idecal+1) |
---|
| 72 | omeg = tab_cntrl(idecal+2) |
---|
| 73 | g = tab_cntrl(idecal+3) |
---|
| 74 | cpp = tab_cntrl(idecal+4) |
---|
| 75 | kappa = tab_cntrl(idecal+5) |
---|
| 76 | daysec = tab_cntrl(idecal+6) |
---|
| 77 | dtvr = tab_cntrl(idecal+7) |
---|
| 78 | etot0 = tab_cntrl(idecal+8) |
---|
| 79 | ptot0 = tab_cntrl(idecal+9) |
---|
| 80 | ztot0 = tab_cntrl(idecal+10) |
---|
| 81 | stot0 = tab_cntrl(idecal+11) |
---|
| 82 | ang0 = tab_cntrl(idecal+12) |
---|
| 83 | pa = tab_cntrl(idecal+13) |
---|
| 84 | preff = tab_cntrl(idecal+14) |
---|
| 85 | ! |
---|
| 86 | clon = tab_cntrl(idecal+15) |
---|
| 87 | clat = tab_cntrl(idecal+16) |
---|
| 88 | grossismx = tab_cntrl(idecal+17) |
---|
| 89 | grossismy = tab_cntrl(idecal+18) |
---|
| 90 | ! |
---|
| 91 | IF ( tab_cntrl(idecal+19)==1. ) THEN |
---|
| 92 | fxyhypb = .TRUE. |
---|
| 93 | ! dzoomx = tab_cntrl(25) |
---|
| 94 | ! dzoomy = tab_cntrl(26) |
---|
| 95 | ! taux = tab_cntrl(28) |
---|
| 96 | ! tauy = tab_cntrl(29) |
---|
| 97 | ELSE |
---|
| 98 | fxyhypb = .FALSE. |
---|
| 99 | ysinus = tab_cntrl(idecal+22)==1. |
---|
| 100 | END IF |
---|
[1632] | 101 | |
---|
[2299] | 102 | day_ini = tab_cntrl(30) |
---|
| 103 | itau_dyn = tab_cntrl(31) |
---|
[2615] | 104 | start_time = tab_cntrl(32) |
---|
[1632] | 105 | |
---|
[2299] | 106 | !------------------------------------------------------------------------------- |
---|
| 107 | WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa |
---|
| 108 | CALL check_dim(im,iim,'im','im') |
---|
| 109 | CALL check_dim(jm,jjm,'jm','jm') |
---|
| 110 | CALL check_dim(lllm,llm,'lm','lllm') |
---|
| 111 | CALL get_var1("rlonu",rlonu) |
---|
| 112 | CALL get_var1("rlatu",rlatu) |
---|
| 113 | CALL get_var1("rlonv",rlonv) |
---|
| 114 | CALL get_var1("rlatv",rlatv) |
---|
| 115 | CALL get_var1("cu" ,cu) |
---|
| 116 | CALL get_var1("cv" ,cv) |
---|
| 117 | CALL get_var1("aire",aire) |
---|
[1632] | 118 | |
---|
[2299] | 119 | var="temps" |
---|
| 120 | IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN |
---|
| 121 | WRITE(lunout,*)TRIM(modname)//": missing field <temps>" |
---|
| 122 | WRITE(lunout,*)TRIM(modname)//": trying with <Time>"; var="Time" |
---|
| 123 | CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) |
---|
| 124 | END IF |
---|
| 125 | CALL err(NF90_GET_VAR(fID,vID,time),"get",var) |
---|
[1632] | 126 | |
---|
[2299] | 127 | ALLOCATE(phis_glo(ip1jmp1)) |
---|
| 128 | CALL get_var1("phisinit",phis_glo) |
---|
| 129 | phis (ijb_u:ije_u) =phis_glo(ijb_u:ije_u); DEALLOCATE(phis_glo) |
---|
[1632] | 130 | |
---|
[2299] | 131 | ALLOCATE(ucov_glo(ip1jmp1,llm)) |
---|
| 132 | CALL get_var2("ucov",ucov_glo) |
---|
| 133 | ucov (ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:); DEALLOCATE(ucov_glo) |
---|
[1673] | 134 | |
---|
[2299] | 135 | ALLOCATE(vcov_glo(ip1jm,llm)) |
---|
| 136 | CALL get_var2("vcov",vcov_glo) |
---|
| 137 | vcov (ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:); DEALLOCATE(vcov_glo) |
---|
[1632] | 138 | |
---|
[2299] | 139 | ALLOCATE(teta_glo(ip1jmp1,llm)) |
---|
| 140 | CALL get_var2("teta",teta_glo) |
---|
| 141 | teta (ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:); DEALLOCATE(teta_glo) |
---|
[1632] | 142 | |
---|
[2299] | 143 | ALLOCATE(masse_glo(ip1jmp1,llm)) |
---|
| 144 | CALL get_var2("masse",masse_glo) |
---|
| 145 | masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:); DEALLOCATE(masse_glo) |
---|
| 146 | |
---|
| 147 | ALLOCATE(ps_glo(ip1jmp1)) |
---|
| 148 | CALL get_var1("ps",ps_glo) |
---|
| 149 | ps (ijb_u:ije_u) = ps_glo(ijb_u:ije_u); DEALLOCATE(ps_glo) |
---|
[1632] | 150 | |
---|
[2299] | 151 | !--- Tracers |
---|
| 152 | ALLOCATE(q_glo(ip1jmp1,llm)) |
---|
| 153 | DO iq=1,nqtot |
---|
| 154 | var=tname(iq) |
---|
[2790] | 155 | #ifdef INCA |
---|
| 156 | IF (var .eq. "O3" ) THEN |
---|
| 157 | IF(NF90_INQ_VARID(fID,var,vID) == NF90_NoErr) THEN |
---|
| 158 | CALL get_var2(var,q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:); CYCLE |
---|
| 159 | ELSE |
---|
| 160 | WRITE(lunout,*) 'Tracer O3 is missing - it is initialized to OX' |
---|
| 161 | IF(NF90_INQ_VARID(fID,"OX",vID) == NF90_NoErr) THEN |
---|
| 162 | CALL get_var2("OX",q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:); CYCLE |
---|
| 163 | ENDIF |
---|
| 164 | ENDIF |
---|
| 165 | ENDIF |
---|
| 166 | #endif |
---|
[2299] | 167 | IF(NF90_INQ_VARID(fID,var,vID)==NF90_NoErr) THEN |
---|
| 168 | CALL get_var2(var,q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:); CYCLE |
---|
| 169 | END IF |
---|
| 170 | WRITE(lunout,*)TRIM(modname)//": Tracer <"//TRIM(var)//"> is missing" |
---|
| 171 | WRITE(lunout,*)" It is hence initialized to zero" |
---|
| 172 | q(ijb_u:ije_u,:,iq)=0. |
---|
| 173 | !--- CRisi: for isotops, theoretical initialization using very simplified |
---|
| 174 | ! Rayleigh distillation las. |
---|
| 175 | IF(ok_isotopes.AND.iso_num(iq)>0) THEN |
---|
| 176 | IF(zone_num(iq)==0) q(:,:,iq)=q(:,:,iqpere(iq))*tnat(iso_num(iq)) & |
---|
| 177 | & *(q(:,:,iqpere(iq))/30.e-3)**(alpha_ideal(iso_num(iq))-1) |
---|
| 178 | IF(zone_num(iq)==1) q(:,:,iq)=q(:,:,iqiso(iso_indnum(iq),phase_num(iq))) |
---|
| 179 | END IF |
---|
| 180 | END DO |
---|
| 181 | DEALLOCATE(q_glo) |
---|
| 182 | CALL err(NF90_CLOSE(fID),"close",fichnom) |
---|
| 183 | day_ini=day_ini+INT(time) |
---|
| 184 | time=time-INT(time) |
---|
[1673] | 185 | |
---|
| 186 | |
---|
[2299] | 187 | CONTAINS |
---|
[1632] | 188 | |
---|
| 189 | |
---|
[2299] | 190 | SUBROUTINE check_dim(n1,n2,str1,str2) |
---|
| 191 | INTEGER, INTENT(IN) :: n1, n2 |
---|
| 192 | CHARACTER(LEN=*), INTENT(IN) :: str1, str2 |
---|
| 193 | CHARACTER(LEN=256) :: s1, s2 |
---|
| 194 | IF(n1/=n2) THEN |
---|
| 195 | s1='value of '//TRIM(str1)//' =' |
---|
| 196 | s2=' read in starting file differs from parametrized '//TRIM(str2)//' =' |
---|
| 197 | WRITE(msg,'(10x,a,i4,2x,a,i4)'),s1,n1,s2,n2 |
---|
| 198 | CALL ABORT_gcm(TRIM(modname),TRIM(msg),1) |
---|
| 199 | END IF |
---|
| 200 | END SUBROUTINE check_dim |
---|
[1632] | 201 | |
---|
| 202 | |
---|
[2299] | 203 | SUBROUTINE get_var1(var,v) |
---|
| 204 | CHARACTER(LEN=*), INTENT(IN) :: var |
---|
| 205 | REAL, INTENT(OUT) :: v(:) |
---|
| 206 | REAL, ALLOCATABLE :: w2(:,:), w3(:,:,:) |
---|
| 207 | INTEGER :: nn(3), dids(3), k, nd, ntot |
---|
[1632] | 208 | |
---|
[2299] | 209 | CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) |
---|
| 210 | ierr=NF90_INQUIRE_VARIABLE(fID,vID,ndims=nd) |
---|
| 211 | IF(nd==1) THEN |
---|
| 212 | CALL err(NF90_GET_VAR(fID,vID,v),"get",var); RETURN |
---|
| 213 | END IF |
---|
| 214 | ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids) |
---|
| 215 | DO k=1,nd; ierr=NF90_INQUIRE_DIMENSION(fID,dids(k),len=nn(k)); END DO |
---|
| 216 | ntot=PRODUCT(nn(1:nd)) |
---|
| 217 | SELECT CASE(nd) |
---|
| 218 | CASE(2); ALLOCATE(w2(nn(1),nn(2))) |
---|
| 219 | CALL err(NF90_GET_VAR(fID,vID,w2),"get",var) |
---|
| 220 | v=RESHAPE(w2,[ntot]); DEALLOCATE(w2) |
---|
| 221 | CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3))) |
---|
| 222 | CALL err(NF90_GET_VAR(fID,vID,w3),"get",var) |
---|
| 223 | v=RESHAPE(w3,[ntot]); DEALLOCATE(w3) |
---|
| 224 | END SELECT |
---|
| 225 | END SUBROUTINE get_var1 |
---|
[1632] | 226 | |
---|
[2299] | 227 | SUBROUTINE get_var2(var,v) |
---|
| 228 | CHARACTER(LEN=*), INTENT(IN) :: var |
---|
| 229 | REAL, INTENT(OUT) :: v(:,:) |
---|
[4013] | 230 | REAL, ALLOCATABLE :: w4(:,:,:,:), w3(:,:,:) |
---|
[2299] | 231 | INTEGER :: nn(4), dids(4), k, nd |
---|
[4013] | 232 | |
---|
| 233 | |
---|
[2299] | 234 | CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) |
---|
[4013] | 235 | ierr=NF90_INQUIRE_VARIABLE(fID,vID,ndims=nd) |
---|
| 236 | |
---|
| 237 | IF(nd==1) THEN |
---|
| 238 | CALL err(NF90_GET_VAR(fID,vID,v),"get",var); RETURN |
---|
| 239 | END IF |
---|
| 240 | ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids) |
---|
| 241 | |
---|
[2299] | 242 | DO k=1,nd; ierr=NF90_INQUIRE_DIMENSION(fID,dids(k),len=nn(k)); END DO |
---|
[4013] | 243 | |
---|
| 244 | SELECT CASE(nd) |
---|
| 245 | CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3))) |
---|
| 246 | CALL err(NF90_GET_VAR(fID,vID,w3),"get",var) |
---|
| 247 | v=RESHAPE(w3,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w3) |
---|
| 248 | CASE(4); ALLOCATE(w4(nn(1),nn(2),nn(3),nn(4))) |
---|
| 249 | CALL err(NF90_GET_VAR(fID,vID,w4),"get",var) |
---|
| 250 | v=RESHAPE(w4,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w4) |
---|
| 251 | END SELECT |
---|
[2299] | 252 | END SUBROUTINE get_var2 |
---|
[1632] | 253 | |
---|
| 254 | |
---|
[2299] | 255 | SUBROUTINE err(ierr,typ,nam) |
---|
| 256 | INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE |
---|
| 257 | CHARACTER(LEN=*), INTENT(IN) :: typ !--- TYPE OF OPERATION |
---|
| 258 | CHARACTER(LEN=*), INTENT(IN) :: nam !--- FIELD/FILE NAME |
---|
| 259 | IF(ierr==NF90_NoERR) RETURN |
---|
| 260 | SELECT CASE(typ) |
---|
| 261 | CASE('inq'); msg="Field <"//TRIM(nam)//"> is missing" |
---|
| 262 | CASE('get'); msg="Reading failed for <"//TRIM(nam)//">" |
---|
| 263 | CASE('open'); msg="File opening failed for <"//TRIM(nam)//">" |
---|
| 264 | CASE('close'); msg="File closing failed for <"//TRIM(nam)//">" |
---|
| 265 | END SELECT |
---|
| 266 | CALL ABORT_gcm(TRIM(modname),TRIM(msg),ierr) |
---|
| 267 | END SUBROUTINE err |
---|
[1632] | 268 | |
---|
[2299] | 269 | END SUBROUTINE dynetat0_loc |
---|