- Timestamp:
- Jul 11, 2021, 11:39:01 PM (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/LMDZ-tracers/libf/dyn3dmem/dynetat0_loc.F90
r3891 r3957 7 7 !------------------------------------------------------------------------------- 8 8 USE parallel_lmdz 9 USE infotrac, ONLY: nqtot, niso, tracers, iTraPha, tnat, alpha_ideal, tra 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 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 12 14 USE control_mod, ONLY: planet_type 13 15 USE assert_eq_m, ONLY: assert_eq 14 16 USE comvert_mod, ONLY: pa,preff 15 USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, & 16 omeg, rad 17 USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad 17 18 USE logic_mod, ONLY: fxyhypb, ysinus 18 19 USE serre_mod, ONLY: clon, clat, grossismx, grossismy 19 USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn, & 20 start_time,day_ini,hour_ini 21 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 22 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 23 IMPLICIT NONE 24 24 include "dimensions.h" … … 39 39 !=============================================================================== 40 40 ! Local variables: 41 CHARACTER(LEN=256) :: sdum, var, modname 41 CHARACTER(LEN=256) :: sdum, var, modname, oldH2O 42 42 INTEGER, PARAMETER :: length=100 43 INTEGER :: iq, fID, vID, idecal, i err43 INTEGER :: iq, fID, vID, idecal, ix, ip, ierr 44 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 45 TYPE(tra), POINTER :: tr 49 46 !------------------------------------------------------------------------------- … … 110 107 CALL check_dim(jm,jjm,'jm','jm') 111 108 CALL check_dim(lllm,llm,'lm','lllm') 112 CALL get_var1("rlonu", rlonu)113 CALL get_var1("rlatu", rlatu)114 CALL get_var1("rlonv", rlonv)115 CALL get_var1("rlatv", rlatv)116 CALL get_var1("cu" ,cu)117 CALL get_var1("cv" ,cv)118 CALL get_var1("aire", aire)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) 119 116 120 117 var="temps" … … 125 122 END IF 126 123 CALL err(NF90_GET_VAR(fID,vID,time),"get",var) 127 128 ALLOCATE(phis_glo(ip1jmp1)) 129 CALL get_var1("phisinit",phis_glo) 130 phis (ijb_u:ije_u) =phis_glo(ijb_u:ije_u); DEALLOCATE(phis_glo) 131 132 ALLOCATE(ucov_glo(ip1jmp1,llm)) 133 CALL get_var2("ucov",ucov_glo) 134 ucov (ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:); DEALLOCATE(ucov_glo) 135 136 ALLOCATE(vcov_glo(ip1jm,llm)) 137 CALL get_var2("vcov",vcov_glo) 138 vcov (ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:); DEALLOCATE(vcov_glo) 139 140 ALLOCATE(teta_glo(ip1jmp1,llm)) 141 CALL get_var2("teta",teta_glo) 142 teta (ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:); DEALLOCATE(teta_glo) 143 144 ALLOCATE(masse_glo(ip1jmp1,llm)) 145 CALL get_var2("masse",masse_glo) 146 masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:); DEALLOCATE(masse_glo) 147 148 ALLOCATE(ps_glo(ip1jmp1)) 149 CALL get_var1("ps",ps_glo) 150 ps (ijb_u:ije_u) = ps_glo(ijb_u:ije_u); DEALLOCATE(ps_glo) 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) 151 130 152 131 !--- Tracers 153 ALLOCATE(q_glo(ip1jmp1,llm))154 132 DO iq=1,nqtot 155 133 tr => tracers(iq) 156 134 var = tr%name 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 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) 159 138 #ifdef INCA 160 ELSE IF(NF90_INQ_VARID(fID, "OX",vID) == NF90_NoErr .AND. var == 'O3') THEN161 WRITE(lunout,*) 'Tracer O3 is missing - it isinitialized to OX'162 CALL get_var2( "OX",q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:); CYCLE139 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) 163 142 #endif 164 END IF 165 WRITE(lunout,*)TRIM(modname)//": Tracer <"//TRIM(var)//"> is missing" 166 WRITE(lunout,*)" It is hence initialized to zero" 167 q(ijb_u:ije_u,:,iq)=0. 168 !--- CRisi: for isotops, theoretical initialization using very simplified 169 ! Rayleigh distillation las. 170 IF(niso > 0 .AND. tr%iso_num > 0) THEN 171 IF(tr%iso_zon == 0) q(:,:,iq) = q(:,:,tr%iprnt) * tnat(tr%iso_num) & 172 * (q(:,:,tr%iprnt)/30.e-3)**(alpha_ideal(tr%iso_num)-1) 173 IF(tr%iso_zon == 1) q(:,:,iq) = q(:,:,iTraPha(tr%iso_num,tr%iso_pha)) 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 174 158 END IF 175 159 END DO 176 DEALLOCATE(q_glo)177 160 CALL err(NF90_CLOSE(fID),"close",fichnom) 178 161 day_ini=day_ini+INT(time) … … 190 173 s1='value of '//TRIM(str1)//' =' 191 174 s2=' read in starting file differs from parametrized '//TRIM(str2)//' =' 192 WRITE(sdum,'(10x,a,i4,2x,a,i4)'), s1,n1,s2,n2175 WRITE(sdum,'(10x,a,i4,2x,a,i4)'),TRIM(s1),n1,TRIM(s2),n2 193 176 CALL ABORT_gcm(TRIM(modname),TRIM(sdum),1) 194 177 END IF … … 196 179 197 180 198 SUBROUTINE get_var1(var,v) 199 CHARACTER(LEN=*), INTENT(IN) :: var 200 REAL, INTENT(OUT) :: v(:) 201 REAL, ALLOCATABLE :: w2(:,:), w3(:,:,:) 202 INTEGER :: nn(3), dids(3), k, nd, ntot 203 204 CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) 205 ierr=NF90_INQUIRE_VARIABLE(fID,vID,ndims=nd) 206 IF(nd==1) THEN 207 CALL err(NF90_GET_VAR(fID,vID,v),"get",var); RETURN 208 END IF 209 ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids) 210 DO k=1,nd; ierr=NF90_INQUIRE_DIMENSION(fID,dids(k),len=nn(k)); END DO 211 ntot=PRODUCT(nn(1:nd)) 212 SELECT CASE(nd) 213 CASE(2); ALLOCATE(w2(nn(1),nn(2))) 214 CALL err(NF90_GET_VAR(fID,vID,w2),"get",var) 215 v=RESHAPE(w2,[ntot]); DEALLOCATE(w2) 216 CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3))) 217 CALL err(NF90_GET_VAR(fID,vID,w3),"get",var) 218 v=RESHAPE(w3,[ntot]); DEALLOCATE(w3) 219 END SELECT 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) 220 201 END SUBROUTINE get_var1 221 202 222 203 223 SUBROUTINE get_var2(var, v)204 SUBROUTINE get_var2(var, v, ib, ie, n_glo) 224 205 CHARACTER(LEN=*), INTENT(IN) :: var 225 206 REAL, INTENT(OUT) :: v(:,:) 226 REAL, ALLOCATABLE :: w4(:,:,:,:) 227 INTEGER :: nn(4), dids(4), k, nd 228 CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) 229 ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids,ndims=nd) 230 DO k=1,nd; ierr=NF90_INQUIRE_DIMENSION(fID,dids(k),len=nn(k)); END DO 231 ALLOCATE(w4(nn(1),nn(2),nn(3),nn(4))) 232 CALL err(NF90_GET_VAR(fID,vID,w4),"get",var) 233 v=RESHAPE(w4,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w4) 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) 234 224 END SUBROUTINE get_var2 235 225 236 226 237 SUBROUTINE err(ierr, typ,nam)227 SUBROUTINE err(ierr, typ, nam) 238 228 INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE 239 229 CHARACTER(LEN=*), INTENT(IN) :: typ !--- TYPE OF OPERATION
Note: See TracChangeset
for help on using the changeset viewer.