Changeset 3957
- Timestamp:
- Jul 11, 2021, 11:39:01 PM (3 years ago)
- Location:
- LMDZ6/branches/LMDZ-tracers/libf
- Files:
-
- 6 edited
- 1 moved
-
dyn3d/dynetat0.F90 (moved) (moved from LMDZ6/branches/LMDZ-tracers/libf/dyn3d/dynetat0.f90) (11 diffs)
-
dyn3d_common/infotrac.F90 (modified) (8 diffs)
-
dyn3dmem/dynetat0_loc.F90 (modified) (6 diffs)
-
dyn3dmem/vlspltqs_loc.F (modified) (1 diff)
-
misc/readTracFiles_mod.f90 (modified) (10 diffs)
-
misc/strings_mod.F90 (modified) (1 diff)
-
phylmd/phyetat0.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/LMDZ-tracers/libf/dyn3d/dynetat0.F90
r3890 r3957 6 6 ! Purpose: Initial state reading. 7 7 !------------------------------------------------------------------------------- 8 USE readTracFiles_mod, ONLY: known_phases, old_phases, nphases, phases_sep 8 9 USE infotrac, ONLY: nqtot, niso, tracers, iTraPha, tnat, alpha_ideal, tra 9 10 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_INQ_VARID, NF90_NoErr, & … … 17 18 USE serre_mod, ONLY: clon, clat, grossismx, grossismy 18 19 USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time 19 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang020 USE ener_mod, ONLY: etot0, ptot0, ztot0, stot0, ang0 20 21 21 22 IMPLICIT NONE … … 37 38 !=============================================================================== 38 39 ! Local variables: 39 CHARACTER(LEN=256) :: sdum, var, modname, oldH2O (3), newH2O(3)40 CHARACTER(LEN=256) :: sdum, var, modname, oldH2O 40 41 INTEGER, PARAMETER :: length=100 41 INTEGER :: iq, fID, vID, idecal, ix !, iml, jml, lml, nqt42 INTEGER :: iq, fID, vID, idecal, ix, ip 42 43 REAL :: time, tab_cntrl(length) !--- RUN PARAMS TABLE 43 TYPE(tra), POINTER :: tr44 TYPE(tra), POINTER :: tr 44 45 !------------------------------------------------------------------------------- 45 46 modname="dynetat0" 46 oldH2O=['H2Ov ','H2Ol ','H2Oi ']47 newH2O=['H2O-g','H2O-l','H2O-s']48 47 49 48 !--- Initial state file opening … … 107 106 CALL check_dim(jm,jjm,'jm','jm') 108 107 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_var2("cu" ,cu)114 CALL get_var2("cv" ,cv)115 CALL get_var2("aire" ,aire)108 CALL get_var1("rlonu", rlonu) 109 CALL get_var1("rlatu", rlatu) 110 CALL get_var1("rlonv", rlonv) 111 CALL get_var1("rlatv", rlatv) 112 CALL get_var2("cu", cu) 113 CALL get_var2("cv", cv) 114 CALL get_var2("aire", aire) 116 115 var="temps" 117 116 IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN … … 121 120 END IF 122 121 CALL err(NF90_GET_VAR(fID,vID,time),"get",var) 123 CALL get_var2("phisinit", phis)124 CALL get_var3("ucov", ucov)125 CALL get_var3("vcov", vcov)126 CALL get_var3("teta", teta)127 CALL get_var3("masse", masse)128 CALL get_var2("ps", ps)122 CALL get_var2("phisinit", phis) 123 CALL get_var3("ucov", ucov) 124 CALL get_var3("vcov", vcov) 125 CALL get_var3("teta", teta) 126 CALL get_var3("masse", masse) 127 CALL get_var2("ps", ps) 129 128 130 129 !--- Tracers … … 132 131 tr => tracers(iq) 133 132 var = tr%name 134 IF(NF90_INQ_VARID(fID,var,vID)==NF90_NoErr) THEN 135 CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var); CYCLE 133 ix = strIdx([('H2O'//phases_sep//known_phases(ip:ip), ip=1, nphases)], var) 134 IF(NF90_INQ_VARID(fID, var, vID) == NF90_NoErr) THEN 135 CALL get_var3(var, q(:,:,:,iq)) 136 136 #ifdef INCA 137 ELSE IF(var == "O3") THEN !--- INCA and O3 missing: take OX instead 138 WRITE(lunout,*) 'Tracer O3 is missing - it is initialized to OX' 139 IF(NF90_INQ_VARID(fID,"OX",vID) == NF90_NoErr) THEN 140 CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var); CYCLE 141 END IF 137 ELSE IF(NF90_INQ_VARID(fID, 'OX', vID) == NF90_NoErr .AND. var == 'O3') THEN 138 WRITE(lunout,*)TRIM(modname)//': Tracer <O3> is missing => initialized to OX' 139 CALL get_var3('OX', q(:,:,:,iq)) 142 140 #endif 143 ELSE !--- Old file, water: H2Ov/l/i instead of H2O-g/-l/-s 144 ix = strIdx(newH2O, var) !--- Current tracer is water (new name) ? 145 IF(ix /= 0) THEN !--- Then read the field, using the old name. 146 IF(NF90_INQ_VARID(fID,oldH2O(ix),vID) == NF90_NoErr) THEN 147 CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var); CYCLE 148 END IF 141 ELSE IF(ix /= 0) THEN !--- Old file, water: H2Ov/l/i instead of H2O_g/_l/_s 142 oldH2O = 'H2O'//old_phases(ix:ix) 143 IF(NF90_INQ_VARID(fID, oldH2O, vID) == NF90_NoErr) THEN 144 WRITE(lunout,*)TRIM(modname)//': Tracer <'//TRIM(var)//'> is missing => initialized to '//TRIM(oldH2O) 145 CALL get_var3(oldH2O, q(:,:,:,iq)) 146 END IF 147 ELSE 148 WRITE(lunout,*)TRIM(modname)//': Tracer <'//TRIM(var)//'> is missing => initialized to zero' 149 q(:,:,:,iq)=0. 150 !--- CRisi: for isotopes, theoretical initialization using very simplified Rayleigh distillation law 151 IF(niso > 0 .AND. tr%iso_num > 0) THEN 152 IF(tr%iso_zon == 0) q(:,:,:,iq) = q(:,:,:,tr%iprnt) * tnat(tr%iso_num) & 153 *(q(:,:,:,tr%iprnt)/30.e-3)**(alpha_ideal(tr%iso_num)-1) 154 IF(tr%iso_zon == 1) q(:,:,:,iq) = q(:,:,:,iTraPha(tr%iso_num,tr%iso_pha)) 149 155 END IF 150 156 END IF 151 WRITE(lunout,*)TRIM(modname)//": Tracer <"//TRIM(var)//"> is missing"152 WRITE(lunout,*)" It is hence initialized to zero"153 q(:,:,:,iq)=0.154 !--- CRisi: for isotops, theoretical initialization using very simplified155 ! Rayleigh distillation las.156 IF(niso > 0 .AND. tr%iso_num > 0) THEN157 IF(tr%iso_zon == 0) q(:,:,:,iq) = q(:,:,:,tr%iprnt) * tnat(tr%iso_num) &158 *(q(:,:,:,tr%iprnt)/30.e-3)**(alpha_ideal(tr%iso_num)-1)159 IF(tr%iso_zon == 1) q(:,:,:,iq) = q(:,:,:,iTraPha(tr%iso_num,tr%iso_pha))160 END IF161 157 END DO 162 163 158 CALL err(NF90_CLOSE(fID),"close",fichnom) 164 159 day_ini=day_ini+INT(time) … … 176 171 s1='value of '//TRIM(str1)//' =' 177 172 s2=' read in starting file differs from parametrized '//TRIM(str2)//' =' 178 WRITE(sdum,'(10x,a,i4,2x,a,i4)'),TRIM( ADJUSTL(s1)),n1,TRIM(ADJUSTL(s2)),n2173 WRITE(sdum,'(10x,a,i4,2x,a,i4)'),TRIM(s1),n1,TRIM(s2),n2 179 174 CALL ABORT_gcm(TRIM(modname),TRIM(sdum),1) 180 175 END IF … … 182 177 183 178 184 SUBROUTINE get_var1(var, v)179 SUBROUTINE get_var1(var, v) 185 180 CHARACTER(LEN=*), INTENT(IN) :: var 186 181 REAL, INTENT(OUT) :: v(:) … … 190 185 191 186 192 SUBROUTINE get_var2(var, v)187 SUBROUTINE get_var2(var, v) 193 188 CHARACTER(LEN=*), INTENT(IN) :: var 194 189 REAL, INTENT(OUT) :: v(:,:) … … 198 193 199 194 200 SUBROUTINE get_var3(var, v)195 SUBROUTINE get_var3(var, v) 201 196 CHARACTER(LEN=*), INTENT(IN) :: var 202 197 REAL, INTENT(OUT) :: v(:,:,:) … … 206 201 207 202 208 SUBROUTINE err(ierr, typ,nam)203 SUBROUTINE err(ierr, typ, nam) 209 204 INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE 210 205 CHARACTER(LEN=*), INTENT(IN) :: typ !--- TYPE OF OPERATION -
LMDZ6/branches/LMDZ-tracers/libf/dyn3d_common/infotrac.F90
r3891 r3957 1 1 MODULE infotrac 2 2 3 USE strings_mod, ONLY: msg, find, strIdx, strFind, strHead, dispTable, testFile, cat, get_in, &3 USE strings_mod, ONLY: msg, find, strIdx, strFind, strHead, dispTable, testFile, cat, get_in, & 4 4 fmsg, test, int2str, strParse, strTail, strReduce, strStack, modname 5 USE readTracFiles_mod, ONLY: readTracersFiles, getKey_init, nphases, delPhase, aliasTracer, &6 5 USE readTracFiles_mod, ONLY: readTracersFiles, getKey_init, nphases, delPhase, old_phases, aliasTracer, & 6 phases_sep, tran0, readIsotopesFile, getKey, known_phases, addPhase, indexUpdate, initIsotopes 7 7 USE trac_types_mod, ONLY: tra, iso, kys 8 8 … … 45 45 ! |--------------------+----------------------+-----------------+---------------+----------------------------| 46 46 ! | water in different | water tagging | water isotopes | other tracers | additional tracers moments | 47 ! | phases: H2O -[gls] | isotopes | | | for higher order schemes |47 ! | phases: H2O_[gls] | isotopes | | | for higher order schemes | 48 48 ! |--------------------+----------------------+-----------------+---------------+----------------------------| 49 49 ! | | | | | | … … 184 184 CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather) 185 185 CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags 186 CHARACTER(LEN= 4):: oldH2O(3) !--- Old water name for the three phases186 CHARACTER(LEN=256) :: oldH2O(3) !--- Old water name for the three phases 187 187 CHARACTER(LEN=256) :: newH2O !--- New water name 188 188 CHARACTER(LEN=256) :: msg1, msg2 !--- Strings for messages … … 283 283 IF(planet_type=='earth') THEN !--- Default for Earth 284 284 nqo = 2; nbtr = 2 285 tracers(:)%name = ['H2O -g','H2O-l','RN ','PB ']286 tracers(:)%prnt = [tran0 ,tran0 ,tran0 ,tran0]287 tracers(:)%igen = [1 ,1 ,1 ,1]288 hadv = [14 ,10 ,10 ,10]289 vadv = [14 ,10 ,10 ,10]285 tracers(:)%name = ['H2O'//phases_sep//'g', 'H2O'//phases_sep//'l', 'RN ', 'PB '] 286 tracers(:)%prnt = [tran0, tran0, tran0, tran0] 287 tracers(:)%igen = [1 , 1 , 1 , 1 ] 288 hadv = [14 , 10 , 10 , 10 ] 289 vadv = [14 , 10 , 10 , 10 ] 290 290 ELSE !--- Default for other planets 291 291 nqo = 0; nbtr = 1 … … 329 329 DO ip = 1, SIZE(oldH2O) 330 330 ix = strIdx(tracers(:)%name,oldH2O(ip)) !--- Old name of water in a specific phase (ix/=0) 331 newH2O = 'H2O'//phases_sep//known_phases(ip:ip) !--- Corresponding new name 332 IF(ix == 0) ix = strIdx(tracers(:)%name,newH2O) !--- New name in an old format file (to be avoided...) 331 333 IF(ix == 0) CYCLE 332 newH2O = 'H2O-'//known_phases(ip:ip) !--- Corresponding new name333 334 nqo = nqo+1; tracers(ix)%name = newH2O !--- One more water phase ; replace old name with one 334 335 tracers(strFind(tracers(:)%nam1,oldH2O(ip)))%nam1 = newH2O … … 341 342 CASE DEFAULT !=== FOUND NEW STYLE TRACERS CONFIG FILE(S) 342 343 !-------------------------------------------------------------------------------------------------------------------------- 343 nqo = 2; IF(ANY(tracers(:)%name == 'H2O -s')) nqo=3344 nqo = 2; IF(ANY(tracers(:)%name == 'H2O'//phases_sep//'s')) nqo=3 344 345 nqtrue = SIZE(tracers, DIM=1) 345 346 nbtr = nqtrue - nqo … … 353 354 IF(.NOT.ALLOCATED(conv_flg)) conv_flg = [(1, it=1, nbtr)] 354 355 IF(.NOT.ALLOCATED( pbl_flg)) pbl_flg = [(1, it=1, nbtr)] 356 !print*,'nqo, nbtr = ',nqo,nbtr 357 !stop 355 358 356 359 #ifdef CPP_StratAer … … 466 469 467 470 !--- iadv = 14 IS ONLY VALID FOR WATER VAPOUR 468 IF(fmsg(iad==14 .AND. t1%name(1:5)/='H2O -g', 'WARNING ! '//TRIM(msg1)//', found for "' &471 IF(fmsg(iad==14 .AND. t1%name(1:5)/='H2O'//phases_sep//'g', 'WARNING ! '//TRIM(msg1)//', found for "' & 469 472 //TRIM(t1%name)//'" but only valid for water vapour ! Setting iadv=10 for "'//TRIM(t1%name)//'".')) t1%iadv=10 470 473 END DO -
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 -
LMDZ6/branches/LMDZ-tracers/libf/dyn3dmem/vlspltqs_loc.F
r3891 r3957 481 481 INTEGER ijbm,ijem 482 482 483 tr => tracers(iq) 483 484 ijb=ij_begin-2*iip1 484 485 ije=ij_end+2*iip1 -
LMDZ6/branches/LMDZ-tracers/libf/misc/readTracFiles_mod.f90
r3891 r3957 14 14 PUBLIC :: getKey_init, getKey, setDirectKeys !--- FUNCTIONS TO GET KEYS FROM tracers & isotopes 15 15 16 PUBLIC :: known_phases, nphases, phases_names, delPhase, addPhase !--- PHASES RELATED VARIABLES AND ROUTINES 16 PUBLIC :: known_phases, old_phases, nphases, phases_names, phases_sep, &!--- VARIABLES RELATED TO THE PHASES 17 delPhase, addPhase !--- ROUTINES TO ADD/REMOVE PHASE TO/FROM A NAME 17 18 18 19 PUBLIC :: tran0, idxAncestor, ancestor !--- GEN 0 TRACER + TOOLS FOR GENERATIONS … … 34 35 !--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN 35 36 CHARACTER(LEN=256), SAVE :: tran0 = 'air' !--- Default transporting fluid 37 CHARACTER(LEN=256), PARAMETER :: old_phases = 'vli' !--- Old phases for water (no separator) 36 38 CHARACTER(LEN=256), PARAMETER :: known_phases = 'gls' !--- Known phases initials 37 39 INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases) !--- Number of phases 38 40 CHARACTER(LEN=256), SAVE :: phases_names(nphases) & !--- Known phases names 39 41 = ['gaseous', 'liquid ', 'solid '] 42 CHARACTER(LEN=1), SAVE :: phases_sep = '_' !--- Phase separator 40 43 LOGICAL, SAVE :: tracs_merge = .TRUE. !--- Merge/stack tracers lists 41 44 LOGICAL, SAVE :: lSortByGen = .TRUE. !--- Sort by growing generation … … 79 82 CHARACTER(LEN=256), ALLOCATABLE :: s(:), sections(:), trac_files(:) 80 83 CHARACTER(LEN=256) :: str, fname, mesg 81 INTEGER :: is, nsec, ierr, it, ntrac, ns 84 INTEGER :: is, nsec, ierr, it, ntrac, ns, ip 82 85 LOGICAL, ALLOCATABLE :: ll(:), lGen3(:) 83 86 !------------------------------------------------------------------------------------------------------------------------------ … … 97 100 IF(.NOT.testFile('traceur.def') .AND. nsec==1) fType = 1 !--- OLD STYLE FILE 98 101 IF(.NOT.testFile('tracer.def')) fType = 2 !--- NEW STYLE ; SINGLE FILE, SEVERAL SECTIONS 99 IF(ALL(ll)) fType = 3!--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED102 IF(ALL(ll)) fType = 3 !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED 100 103 IF(ANY(ll) .AND. fType/=3) THEN !--- MISSING FILES 101 104 IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN … … 129 132 CALL msg(ns == 3 .AND. it == 1, 'This file is for air tracers only') 130 133 CALL msg(ns == 4 .AND. it == 1, 'This files specifies the transporting fluid') 131 SELECT CASE(s(3)) !--- name and phase of the tracer 132 CASE('H2Ov'); tracs(it)%name = 'H2O-g'; tracs(it)%phas = 'g' 133 CASE('H2Ol'); tracs(it)%name = 'H2O-l'; tracs(it)%phas = 'l' 134 CASE('H2Oi'); tracs(it)%name = 'H2O-s'; tracs(it)%phas = 's' 135 CASE DEFAULT; tracs(it)%name = s(3) ; tracs(it)%phas = 'g' 136 END SELECT 134 tracs(it)%name = s(3); tracs(it)%phas = known_phases(1:1) !--- Default: name, gazeous phase "g" 135 DO ip = 1, nphases !--- Deal with old water names 136 IF(s(3) /= 'H2O'//old_phases(ip:ip)) CYCLE 137 tracs(it)%phas = known_phases(ip:ip); tracs(it)%name = 'H2O'//phases_sep//TRIM(tracs(it)%phas) 138 END DO 137 139 tracs(it)%prnt = tran0 !--- Default transporting fluid: Air 138 140 IF(ns == 4) tracs(it)%prnt = s(4) !--- Transporting fluid name … … 549 551 trn=TRIM(tr(iq)%name); nam=trn !--- Tracer name (regular case) 550 552 IF(lTg) nam = TRIM(tr(iq)%prnt) !--- Parent name (tagging case) 551 IF(lEx) nam = TRIM(nam)// '-'//pha(ip:ip)!--- Phase extension needed553 IF(lEx) nam = TRIM(nam)//phases_sep//pha(ip:ip) !--- Phase extension needed 552 554 IF(lTg) nam = TRIM(nam)//'_'//TRIM(trn) !--- <parent>_<name> for tags 553 555 ttr(it) = tr(iq) !--- Same <key>=<val> pairs … … 556 558 ttr(it)%phas = pha(ip:ip) !--- Single phase entry 557 559 IF(lEx.AND.tr(iq)%igen>1) THEN 558 ttr(it)%prnt = TRIM(ttr(it)%prnt)// '-'//pha(ip:ip)559 ttr(it)%nam1 = TRIM(ttr(it)%nam1)// '-'//pha(ip:ip)560 ttr(it)%prnt = TRIM(ttr(it)%prnt)//phases_sep//pha(ip:ip) 561 ttr(it)%nam1 = TRIM(ttr(it)%nam1)//phases_sep//pha(ip:ip) 560 562 END IF 561 563 it=it+1 … … 698 700 tnam = t1(iq)%name !--- Original name 699 701 IF(COUNT(t1%name == tnam) == 1) CYCLE !--- Current tracer is not duplicated: finished 700 tnam_new = TRIM(tnam)// '-'//TRIM(sections(is)%name)!--- Same with section extension702 tnam_new = TRIM(tnam)//phases_sep//TRIM(sections(is)%name) !--- Same with section extension 701 703 nq = SUM(nt(1:is-1)) !--- Number of tracers in previous sections 702 704 ns = nt(is) !--- Number of tracers in the current section … … 1231 1233 i = INDEX(s, '_'); l = LEN_TRIM(s) 1232 1234 IF(i == 0) THEN 1233 IF(s(l-1:l-1)== '-'.AND. INDEX(known_phases,s(l:l)) /= 0) out = s(1:l-2)1235 IF(s(l-1:l-1)==phases_sep .AND. INDEX(known_phases,s(l:l)) /= 0) out = s(1:l-2) 1234 1236 ELSE; i=i-1 1235 IF(s(i-1:i-1)== '-'.AND. INDEX(known_phases,s(i:i)) /= 0) out = s(1:i-2)//s(i+1:l)1237 IF(s(i-1:i-1)==phases_sep .AND. INDEX(known_phases,s(i:i)) /= 0) out = s(1:i-2)//s(i+1:l) 1236 1238 END IF 1237 1239 END FUNCTION delPhase … … 1244 1246 IF(s == '') RETURN 1245 1247 i = INDEX(s, '_'); l = LEN_TRIM(s) 1246 IF(i == 0) out = TRIM(s)// '-'//pha1247 IF(i /= 0) out = s(1:i-1)// '-'//pha//'_'//s(i+1:l)1248 IF(i == 0) out = TRIM(s)//phases_sep//pha 1249 IF(i /= 0) out = s(1:i-1)//phases_sep//pha//'_'//s(i+1:l) 1248 1250 END FUNCTION addPhase_1 1249 1251 !------------------------------------------------------------------------------------------------------------------------------ -
LMDZ6/branches/LMDZ-tracers/libf/misc/strings_mod.F90
r3892 r3957 186 186 187 187 !============================================================================================================================== 188 !=== Extract first or last element of a string "str" delimited by separator "sep" =============================================189 !============================================================================================================================== 190 CHARACTER(LEN=256) FUNCTION strHead_1(str,sep ) RESULT(out)188 !=== Extract the substring in front of the last (first if lFirst==TRUE) occurrence of separator "sep" in "str" ================ 189 !============================================================================================================================== 190 CHARACTER(LEN=256) FUNCTION strHead_1(str,sep,lFirst) RESULT(out) 191 191 CHARACTER(LEN=*), INTENT(IN) :: str 192 192 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep 193 LOGICAL, OPTIONAL, INTENT(IN) :: lFirst 194 LOGICAL :: lf 195 lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst 193 196 IF(PRESENT(sep)) THEN 194 out = str(1:INDEX(str,sep,. TRUE.)-1)197 out = str(1:INDEX(str,sep,.NOT.lf)-1) 195 198 ELSE 196 out = str(1:INDEX(str,'/',. TRUE.)-1)199 out = str(1:INDEX(str,'/',.NOT.lf)-1) 197 200 END IF 198 201 IF(out == '') out = str 199 202 END FUNCTION strHead_1 200 203 !============================================================================================================================== 201 CHARACTER(LEN=256) FUNCTION strTail_1(str,sep) RESULT(out) 202 CHARACTER(LEN=*), INTENT(IN) :: str 203 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep 204 IF(PRESENT(sep)) THEN 205 out = str(INDEX(str,sep,.TRUE.)+LEN(sep):LEN_TRIM(str)) 206 ELSE 207 out = str(INDEX(str,'/',.TRUE.)+1:LEN_TRIM(str)) 208 END IF 209 IF(out == '') out = str 210 END FUNCTION strTail_1 211 !============================================================================================================================== 212 FUNCTION strHead_m(str,sep) RESULT(out) 204 FUNCTION strHead_m(str,sep,lFirst) RESULT(out) 213 205 CHARACTER(LEN=256), ALLOCATABLE :: out(:) 214 206 CHARACTER(LEN=*), INTENT(IN) :: str(:) 215 207 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep 208 LOGICAL, OPTIONAL, INTENT(IN) :: lFirst 209 LOGICAL :: lf 216 210 INTEGER :: k 211 lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst 217 212 IF(PRESENT(sep)) THEN 218 out = [(strHead_1(str(k),sep ),k=1, SIZE(str))]213 out = [(strHead_1(str(k),sep,.NOT.lf), k=1, SIZE(str))] 219 214 ELSE 220 out = [(strHead_1(str(k) ),k=1, SIZE(str))]215 out = [(strHead_1(str(k),lFirst=.NOT.lf), k=1, SIZE(str))] 221 216 END IF 222 217 223 218 END FUNCTION strHead_m 224 219 !============================================================================================================================== 225 FUNCTION strTail_m(str,sep) RESULT(out) 220 !=== Extract the substring following the last (first if lFirst==TRUE) occurrence of separator "sep" in "str" ================== 221 !============================================================================================================================== 222 CHARACTER(LEN=256) FUNCTION strTail_1(str,sep,lFirst) RESULT(out) 223 CHARACTER(LEN=*), INTENT(IN) :: str 224 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep 225 LOGICAL, OPTIONAL, INTENT(IN) :: lFirst 226 LOGICAL :: lf 227 lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst 228 IF(PRESENT(sep)) THEN 229 out = str(INDEX(str,sep,.NOT.lf)+LEN(sep):LEN_TRIM(str)) 230 ELSE 231 out = str(INDEX(str,'/',.NOT.lf)+1:LEN_TRIM(str)) 232 END IF 233 IF(out == '') out = str 234 END FUNCTION strTail_1 235 !============================================================================================================================== 236 FUNCTION strTail_m(str,sep,lFirst) RESULT(out) 226 237 CHARACTER(LEN=256), ALLOCATABLE :: out(:) 227 238 CHARACTER(LEN=*), INTENT(IN) :: str(:) 228 239 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep 240 LOGICAL, OPTIONAL, INTENT(IN) :: lFirst 241 LOGICAL :: lf 229 242 INTEGER :: k 243 lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst 230 244 IF(PRESENT(sep)) THEN 231 out = [(strTail_1(str(k),sep ),k=1, SIZE(str))]245 out = [(strTail_1(str(k),sep,.NOT.lf), k=1, SIZE(str))] 232 246 ELSE 233 out = [(strTail_1(str(k) ),k=1, SIZE(str))]247 out = [(strTail_1(str(k),lFirst=.NOT.lf), k=1, SIZE(str))] 234 248 END IF 235 249 END FUNCTION strTail_m -
LMDZ6/branches/LMDZ-tracers/libf/phylmd/phyetat0.F90
r3891 r3957 575 575 USE dimphy, only: klon 576 576 USE print_control_mod, ONLY: lunout 577 577 USE readTracFiles_mod, ONLY: known_phases, old_phases, nphases, phases_sep 578 USE strings_mod, ONLY: strIdx 578 579 IMPLICIT NONE 579 580 … … 588 589 ! Local variables 589 590 LOGICAL found 591 INTEGER :: ix, ip 592 CHARACTER(LEN=256) :: oldname 590 593 591 594 CALL get_field(name, field, found) 595 ix = strIdx([('trs_H2O'//phases_sep//known_phases(ip:ip), ip=1, nphases)], name) 596 IF (.NOT. found .AND. ix /= 0) THEN !--- Old file, water: H2Ov/l/i instead of H2O_g/_l/_s 597 oldname = 'trs_H2O'//old_phases(ix:ix) 598 CALL get_field(oldname, field, found) 599 END IF 592 600 IF (.NOT. found) THEN 593 601 WRITE(lunout,*) "phyetat0: Le champ <",TRIM(name),"> est absent" 594 602 WRITE(lunout,*) "Depart legerement fausse. Mais je continue" 595 603 field(:,:)=default 604 ELSE IF(ix /= 0) THEN 605 WRITE(lunout,*)"phyetat0: Le champ <",TRIM(name),"> est absent => initialisation a <"//TRIM(oldname)//">" 596 606 ENDIF 597 607 WRITE(lunout,*) TRIM(name), descr, MINval(field),MAXval(field)
Note: See TracChangeset
for help on using the changeset viewer.
