Index: LMDZ6/branches/LMDZ-tracers/DefLists/isotopes_params.def =================================================================== --- LMDZ6/branches/LMDZ-tracers/DefLists/isotopes_params.def (revision 3985) +++ LMDZ6/branches/LMDZ-tracers/DefLists/isotopes_params.def (revision 3985) @@ -0,0 +1,8 @@ +&H2O + params deltaO18_oce=0.0 fac_enrichoce18=0.0005 talph1_O18=1137. talph2_O18=-0.4156 talph3_O18=-2.0667E-3 talps1_O18=11.839 talps2_O18=-0.028244 tkcin0_O18=0.006 tkcin1_O18=0.000285 tkcin2_O18=0.00082 tdifrel_O18=1./0.9723 alpha_liq_sol_O18=1.00291 fac_coeff_eq17_liq=0.529 fac_coeff_eq17_ice=0.529 + H2[16]O alpha=1.000 tnat=1.0000 toce=tnat tcorr=1.0 talph1=0.0 talph2=0.0 talph3=0.0 talps1=0.0 talps2=0.0 tkcin0=0.0 tkcin1=0.0 tkcin2=0.0 tdifrel=1.0 alpha_liq_sol=1.0 Rdefault=tnat*1.0 Rmethox=1.0 + H2[17]O alpha=1.003 tnat=40.000e-6 toce=tnat*(1.0+deltaO18_oce/1000.0)^pente_MWL tcorr=1.0+fac_enrichoce18*pente_MWL talph1=talph1_O18 talph2=talph2_O18 talph3=talph3_O18 talps1=talps1_O18 talps2=talps2_O18 tkcin0=tkcin0_O18*fac_kcin tkcin1=tkcin1_O18*fac_kcin tkcin2=tkcin2_O18*fac_kcin tdifrel=1./0.98555 alpha_liq_sol=alpha_liq_sol_O18^fac_coeff_eq17_liq Rdefault=tnat*(1.0-3.15/1000.) Rmethox=tnat*(1.0+230./1000.) pente_MWL=0.528 fac_kcin=(tdifrel-1.0)/(tdifrel_O18-1.0) + H2[18]O alpha=1.006 tnat=2005.2e-6 toce=tnat*(1.0+deltaO18_oce/1000.0) tcorr=1.0+fac_enrichoce18 talph1=talph1_O18 talph2=talph2_O18 talph3=talph3_O18 talps1=talps1_O18 talps2=talps2_O18 tkcin0=tkcin0_O18 tkcin1=tkcin1_O18 tkcin2=tkcin2_O18 tdifrel=tdifrel_O18 alpha_liq_sol=alpha_liq_sol_O18 Rdefault=tnat*(1.0-6.00/1000.) Rmethox=tnat*(1.0+130./1000.) + H[2]HO alpha=1.010 tnat=155.78e-6 toce=tnat*(1.0+deltaO18_oce/1000.0*pente_MWL) tcorr=1.0+fac_enrichoce18*pente_MWL talph1=24844. talph2=-76.248 talph3=52.612E-3 talps1=16288. talps2=-0.0934 tkcin0=tkcin0_O18*fac_kcin tkcin1=tkcin1_O18*fac_kcin tkcin2=tkcin2_O18*fac_kcin tdifrel=1./0.9755 alpha_liq_sol=1.0212 Rdefault=tnat*(1.0+(10.0-60.0*pente_MWL)/1000.) Rmethox=tnat*(1.0-25.0/1000.) pente_MWL=8.0 fac_kcin=(tdifrel-1.0)/(tdifrel_O18-1.0) + H[3]HO alpha=1.000 tnat=0.0000 toce=4.0E-19 tcorr=1.0 talph1=46480. talph2=-103.87 talph3=0.0 talps1=46480. talps2=-103.87 tkcin0=0.01056 tkcin1=0.0005016 tkcin2=0.0014432 tdifrel=1./0.968 alpha_liq_sol=1.0 Rdefault=0.0 Rmethox=0.0 + Index: LMDZ6/branches/LMDZ-tracers/DefLists/tracer.def =================================================================== --- LMDZ6/branches/LMDZ-tracers/DefLists/tracer.def (revision 3985) +++ LMDZ6/branches/LMDZ-tracers/DefLists/tracer.def (revision 3985) @@ -0,0 +1,6 @@ +&version=1.0 +&lmdz +default phases=g hadv=10 vadv=10 parent=air type=tracer +H2O phases=g hadv=14 vadv=14 +H2O phases=ls +Aga hadv=0 vadv=0 Index: LMDZ6/branches/LMDZ-tracers/DefLists/tracer_RN_PB.def =================================================================== --- LMDZ6/branches/LMDZ-tracers/DefLists/tracer_RN_PB.def (revision 3985) +++ LMDZ6/branches/LMDZ-tracers/DefLists/tracer_RN_PB.def (revision 3985) @@ -0,0 +1,7 @@ +&version=1.0 +&lmdz +default phases=g hadv=10 vadv=10 parent=air type=tracer +H2O phases=g hadv=14 vadv=14 +H2O phases=ls +Aga hadv=0 vadv=0 +RN,PB Index: LMDZ6/branches/LMDZ-tracers/DefLists/traceur.def =================================================================== --- LMDZ6/branches/LMDZ-tracers/DefLists/traceur.def (revision 3968) +++ (revision ) @@ -1,5 +1,0 @@ -4 -14 14 H2Ov -10 10 H2Ol -10 10 H2Oi -00 00 Aga Index: LMDZ6/branches/LMDZ-tracers/DefLists/traceur_RN_PB.def =================================================================== --- LMDZ6/branches/LMDZ-tracers/DefLists/traceur_RN_PB.def (revision 3968) +++ (revision ) @@ -1,7 +1,0 @@ -6 -14 14 H2Ov -10 10 H2Ol -10 10 H2Oi -10 10 Aga -10 10 RN -10 10 PB Index: LMDZ6/branches/LMDZ-tracers/arch/arch-X64_IRENE.fcm =================================================================== --- LMDZ6/branches/LMDZ-tracers/arch/arch-X64_IRENE.fcm (revision 3968) +++ LMDZ6/branches/LMDZ-tracers/arch/arch-X64_IRENE.fcm (revision 3985) @@ -10,6 +10,6 @@ %PROD_FFLAGS -O3 -axAVX,SSE4.2 -fp-model fast=2 %DEV_FFLAGS -fp-model strict -p -g -O2 -traceback -fp-stack-check -%DEBUG_FFLAGS -fp-model strict -p -g -traceback -fp-stack-check -ftrapuv -#%DEBUG_FFLAGS -fp-model strict -p -g -traceback -fp-stack-check -ftrapuv -check bounds,noarg_temp_created,pointers,stack,uninit -debug full -init=arrays -init=snan +#%DEBUG_FFLAGS -fp-model strict -p -g -traceback -fp-stack-check -ftrapuv +%DEBUG_FFLAGS -fp-model strict -p -g -traceback -fp-stack-check -ftrapuv -check bounds,noarg_temp_created,pointers,stack,uninit -debug full -init=arrays -init=snan %MPI_FFLAGS %OMP_FFLAGS -qopenmp Index: LMDZ6/branches/LMDZ-tracers/libf/dyn3d_common/infotrac.F90 =================================================================== --- LMDZ6/branches/LMDZ-tracers/libf/dyn3d_common/infotrac.F90 (revision 3968) +++ LMDZ6/branches/LMDZ-tracers/libf/dyn3d_common/infotrac.F90 (revision 3985) @@ -2,5 +2,5 @@ USE strings_mod, ONLY: msg, find, strIdx, strFind, strHead, dispTable, testFile, cat, get_in, & - fmsg, test, int2str, strParse, strTail, strReduce, strStack, modname + fmsg, test, int2str, strParse, strTail, strReduce, strStack, modname, reduceExpr USE readTracFiles_mod, ONLY: readTracersFiles, getKey_init, nphases, delPhase, old_phases, aliasTracer, & phases_sep, tran0, readIsotopesFile, getKey, known_phases, addPhase, indexUpdate, initIsotopes @@ -202,4 +202,8 @@ oldH2O = ['H2Ov','H2Ol','H2Oi'] +! lerr = reduceExpr('1.0+-470.0/1000.',msg1) +!print*,msg1 +!stop + !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION CALL msg('type_trac='//TRIM(type_trac)) @@ -279,4 +283,5 @@ IF(planet_type=='earth') THEN !--- Default for Earth nqo = 2; nbtr = 2 + ALLOCATE(tracers(nqo+nbtr)) tracers(:)%name = ['H2O'//phases_sep//'g', 'H2O'//phases_sep//'l', 'RN ', 'PB '] tracers(:)%prnt = [tran0, tran0, tran0, tran0] @@ -286,4 +291,5 @@ ELSE !--- Default for other planets nqo = 0; nbtr = 1 + ALLOCATE(tracers(nqo+nbtr)) tracers(:)%name = ['dummy'] tracers(:)%prnt = ['dummy'] @@ -354,26 +360,4 @@ IF(.NOT.ALLOCATED(conv_flg)) conv_flg = [(1, it=1, nbtr)] IF(.NOT.ALLOCATED( pbl_flg)) pbl_flg = [(1, it=1, nbtr)] -!print*,'nqo, nbtr = ',nqo,nbtr -!stop - -#ifdef CPP_StratAer - IF (type_trac == 'coag') THEN - nbtr_bin=0 - nbtr_sulgas=0 - DO iq = 1, nqtrue - IF(tracers(iq)%name(1:3)=='BIN') nbtr_bin = nbtr_bin +1 - IF(tracers(iq)%name(1:3)=='GAS') nbtr_sulgas = nbtr_sulgas+1 - SELECT CASE(tracers(iq)%name) - CASE('BIN01'); id_BIN01_strat = iq - nqo; CALL msg('id_BIN01_strat=', id_BIN01_strat) - CASE('GASOCS'); id_OCS_strat = iq - nqo; CALL msg('id_OCS_strat =', id_OCS_strat) - CASE('GASSO2'); id_SO2_strat = iq - nqo; CALL msg('id_SO2_strat =', id_SO2_strat) - CASE('GASH2SO4'); id_H2SO4_strat = iq - nqo; CALL msg('id_H2SO4_strat=', id_H2SO4_strat) - CASE('GASTEST'); id_TEST_strat = iq - nqo; CALL msg('id_TEST_strat=' , id_TEST_strat) - END SELECT - END DO - CALL msg('nbtr_bin =',nbtr_bin) - CALL msg('nbtr_sulgas =',nbtr_sulgas) - END IF -#endif !--- Transfert number of tracers to Reprobus @@ -459,14 +443,15 @@ WRITE(msg2,'(a,i2,a)')'iadv=',iad,' not implemented yet for' - !--- ONLY TESTED VALUES FOR TRACERS FOR NOW: iadv = 14, 10 (and 0) + !--- ONLY TESTED VALUES FOR TRACERS FOR NOW: iadv = 14, 10 (and 0 for non-transported tracers) IF(ALL( [10,14,0] /= iad) ) CALL abort_gcm(modname, TRIM(msg1)//' ; only iadv=10 and iadv=14 are tested !', 1) - !--- ONLY TESTED VALUES FOR CHILDS FOR NOW: iadv = 10 (CHILDS: TRACERS OF GENERATION GREATER THAN 1) + !--- ONLY TESTED VALUES FOR CHILDS FOR NOW: iadv = 10 (CHILDS: TRACERS OF GENERATION GREATER THAN 1) IF(fmsg(iad/=10.AND.t1%igen>1,'WARNING ! '//TRIM(msg2)//' childs. Setting iadv=10 for "'//TRIM(t1%name)//'".')) t1%iadv=10 - !--- ONLY TESTED VALUES FOR PARENTS FOR NOW: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 1) - IF(t1%igen==1 .AND. ALL([10,14]/=iad)) CALL abort_gcm(modname, TRIM(msg2)//' parents: schemes 10 or 14 only !', 1) - - !--- iadv = 14 IS ONLY VALID FOR WATER VAPOUR + !--- ONLY TESTED VALUES FOR PARENTS HAVING CHILDS FOR NOW: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 1) + IF(ANY(ttr(:)%igen>1) .AND. t1%igen==1 .AND. ALL([10,14]/=iad)) & + CALL abort_gcm(modname, TRIM(msg2)//' parents: schemes 10 or 14 only !', 1) + + !--- ONLY VALID SCHEME NUMBER FOR WATER VAPOUR: iadv = 14 IF(fmsg(iad==14 .AND. t1%name(1:5)/='H2O'//phases_sep//'g', 'WARNING ! '//TRIM(msg1)//', found for "' & //TRIM(t1%name)//'" but only valid for water vapour ! Setting iadv=10 for "'//TRIM(t1%name)//'".')) t1%iadv=10 Index: LMDZ6/branches/LMDZ-tracers/libf/dyn3dmem/dynetat0_loc.F90 =================================================================== --- LMDZ6/branches/LMDZ-tracers/libf/dyn3dmem/dynetat0_loc.F90 (revision 3968) +++ LMDZ6/branches/LMDZ-tracers/libf/dyn3dmem/dynetat0_loc.F90 (revision 3985) @@ -7,17 +7,20 @@ !------------------------------------------------------------------------------- USE parallel_lmdz - USE readTracFiles_mod, ONLY: known_phases, old_phases, nphases, phases_sep USE infotrac, ONLY: nqtot, niso, tracers, iTraPha, tnat, alpha_ideal, tra - USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_INQ_VARID, NF90_INQUIRE_DIMENSION, & - NF90_INQUIRE, NF90_CLOSE, NF90_GET_VAR, NF90_NoErr, NF90_INQUIRE_VARIABLE - USE strings_mod, ONLY: strIdx + USE netcdf, ONLY: NF90_OPEN, NF90_INQUIRE_DIMENSION, NF90_INQ_VARID, & + NF90_NOWRITE, NF90_CLOSE, NF90_INQUIRE_VARIABLE, NF90_GET_VAR, & + NF90_GET_ATT, NF90_NoErr, NF90_INQUIRE USE control_mod, ONLY: planet_type USE assert_eq_m, ONLY: assert_eq USE comvert_mod, ONLY: pa,preff - USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad + USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, & + omeg, rad USE logic_mod, ONLY: fxyhypb, ysinus USE serre_mod, ONLY: clon, clat, grossismx, grossismy - USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time - USE ener_mod, ONLY: etot0, ptot0, ztot0, stot0, ang0 + USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn, & + start_time,day_ini + USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 + USE strings_mod, ONLY: strIdx + USE readTracFiles_mod, ONLY: known_phases, old_phases, nphases, phases_sep IMPLICIT NONE @@ -41,5 +44,5 @@ CHARACTER(LEN=256) :: sdum, var, modname, oldH2O INTEGER, PARAMETER :: length=100 - INTEGER :: iq, fID, vID, idecal, ix, ip, ierr + INTEGER :: iq, fID, vID, idecal, ix, ip, ierr, ib, ie, nglo REAL :: time, tab_cntrl(length) !--- RUN PARAMS TABLE TYPE(tra), POINTER :: tr @@ -122,10 +125,12 @@ END IF CALL err(NF90_GET_VAR(fID,vID,time),"get",var) - CALL get_var1("phisinit", phis, ijb_u, ije_u, ip1jmp1) - CALL get_var2("ucov", ucov, ijb_u, ije_u, ip1jmp1) - CALL get_var2("vcov", vcov, ijb_v, ije_v, ip1jm) - CALL get_var2("teta", teta, ijb_u, ije_u, ip1jmp1) - CALL get_var2("masse", masse, ijb_u, ije_u, ip1jmp1) - CALL get_var1("ps", ps, ijb_u, ije_u, ip1jmp1) + ib = ijb_v; ie = ije_v; nglo = ip1jm + CALL get_var2("vcov", vcov(ib:ie,:), ib, ie, nglo) + ib = ijb_u; ie = ije_u; nglo = ip1jmp1 + CALL get_var2("ucov", ucov(ib:ie,:), ib, ie, nglo) + CALL get_var2("teta", teta(ib:ie,:), ib, ie, nglo) + CALL get_var2("masse", masse(ib:ie,:), ib, ie, nglo) + CALL get_var1("phisinit", phis(ib:ie), ib, ie) + CALL get_var1("ps", ps(ib:ie), ib, ie) !--- Tracers @@ -135,9 +140,9 @@ ix = strIdx([('H2O'//phases_sep//known_phases(ip:ip), ip=1, nphases)], var) IF(NF90_INQ_VARID(fID, var, vID) == NF90_NoErr) THEN - CALL get_var2(var, q(:,:,iq), ijb_u, ije_u, ip1jmp1) + CALL get_var2(var, q(ib:ie,:,iq), ib, ie, nglo) #ifdef INCA ELSE IF(NF90_INQ_VARID(fID, 'OX', vID) == NF90_NoErr .AND. var == 'O3') THEN WRITE(lunout,*)TRIM(modname)//': Tracer is missing => initialized to OX' - CALL get_var2('OX', q(:,:,iq), ijb_u, ije_u, ip1jmp1) + CALL get_var2('OX', q(ib:ie,:,iq), ib, ie, nglo) #endif ELSE IF(ix /= 0) THEN !--- Old file, water: H2Ov/l/i instead of H2O-g/-l/-s @@ -145,9 +150,9 @@ IF(NF90_INQ_VARID(fID, oldH2O, vID) == NF90_NoErr) THEN WRITE(lunout,*)TRIM(modname)//': Tracer <'//TRIM(var)//'> is missing => initialized to '//TRIM(oldH2O) - CALL get_var2(oldH2O, q(:,:,iq), ijb_u, ije_u, ip1jmp1) + CALL get_var2(oldH2O, q(ib:ie,:,iq), ib, ie, nglo) END IF ELSE WRITE(lunout,*)TRIM(modname)//': Tracer <'//TRIM(var)//'> is missing => initialized to zero' - q(ijb_u:ije_u,:,iq)=0. + q(ib:ie,:,iq)=0. !--- CRisi: for isotopes, theoretical initialization using very simplified Rayleigh distillation law IF(niso > 0 .AND. tr%iso_num > 0) THEN @@ -179,23 +184,22 @@ -SUBROUTINE get_var1(var, v, ib, ie, n_glo) +SUBROUTINE get_var1(var, v, ib, ie) +!--- Usable for fields up to rank 4 with single time record (last index) +!--- Result: stacked in a vector. Used for 2D (single layer) fields. CHARACTER(LEN=*), INTENT(IN) :: var REAL, INTENT(OUT) :: v(:) - INTEGER, OPTIONAL, INTENT(IN) :: ib, ie, n_glo + INTEGER, OPTIONAL, INTENT(IN) :: ib, ie REAL, ALLOCATABLE :: w(:,:,:,:), v_glo(:) - INTEGER :: nn(4), dids(4), k, nd, ntot + INTEGER :: n(4), dids(4), k, nd, ntot CALL err(NF90_INQ_VARID(fID, var, vID), "inq", var) ierr = NF90_INQUIRE_VARIABLE(fID, vID, dimids=dids, ndims=nd) - nn(:) = 1; DO k=1,nd; ierr = NF90_INQUIRE_DIMENSION(fID, dids(k), len=nn(k)); END DO - ntot = PRODUCT(nn(1:nd)) - ALLOCATE(w(nn(1), nn(2), nn(3), nn(4))) + n(:) = 1; DO k = 1, nd; ierr = NF90_INQUIRE_DIMENSION(fID, dids(k), len=n(k)); END DO + IF(is_rec(fID, dids(nd)) .AND. n(nd) /= 1) & + CALL abort_gcm(TRIM(modname), 'Several records records for <'//TRIM(var)//'>') + ntot = PRODUCT(n(1:nd)) + ALLOCATE(w(n(1), n(2), n(3), n(4)), v_glo(ntot)) CALL err(NF90_GET_VAR(fID, vID, w), "get", var) - ALLOCATE(v_glo(ntot)); v_glo=RESHAPE(w, [ntot]); DEALLOCATE(w) - IF(PRESENT(n_glo).AND.PRESENT(ib).AND.PRESENT(ie)) THEN - IF(ntot/=n_glo) CALL abort_gcm(TRIM(modname), 'Shape mismatch for "'//TRIM(var)//'"') - v(ib:ie) = v_glo(ib:ie) - ELSE - v(:) = v_glo(:) - END IF + v_glo(:) = RESHAPE(w, [ntot]); DEALLOCATE(w) + IF(PRESENT(ib).AND.PRESENT(ie)) THEN; v(:) = v_glo(ib:ie); ELSE; v(:) = v_glo(:); END IF DEALLOCATE(v_glo) END SUBROUTINE get_var1 @@ -203,24 +207,40 @@ SUBROUTINE get_var2(var, v, ib, ie, n_glo) +!--- Usable for fields up to rank 4 with one or several time records (last index) +!--- Result: stacked in a 2D array (1st/2nd index: horizontal/vertical). Used for 3D (several layers) fields. CHARACTER(LEN=*), INTENT(IN) :: var REAL, INTENT(OUT) :: v(:,:) INTEGER, INTENT(IN) :: ib, ie, n_glo REAL, ALLOCATABLE :: w(:,:,:,:), v_glo(:,:) - INTEGER :: nn(4), dids(4), k, nd, nh, nv, tid + INTEGER :: n(4), dids(4), k, nd, nh, nv, tid CALL err(NF90_INQ_VARID(fID, var, vID), "inq", var) ierr = NF90_INQUIRE_VARIABLE(fID, vID, dimids=dids, ndims=nd) - nn(:) = 1; DO k=1,nd; ierr = NF90_INQUIRE_DIMENSION(fID, dids(k), len=nn(k)); END DO - IF(NF90_INQUIRE(fID, unlimitedDimId=tid) == NF90_NOERR) THEN - nh = PRODUCT(nn(1:nd-2)); nv = nn(nd-1); nn(nd) = 1 + n(:) = 1; DO k = 1, nd; ierr = NF90_INQUIRE_DIMENSION(fID, dids(k), len=n(k)); END DO + IF(is_rec(fID, dids(nd))) THEN + IF(n(nd) /= 1) CALL abort_gcm(TRIM(modname), 'Several records records for <'//TRIM(var)//'>.') + nh = PRODUCT(n(1:nd-2)); nv = n(nd-1) ELSE - nh = PRODUCT(nn(1:nd-1)); nv = nn(nd) - END IF - ALLOCATE(w(nn(1), nn(2), nn(3), nn(4))) + nh = PRODUCT(n(1:nd )); nv = n(nd) + END IF + IF(nh/=n_glo .OR. nv/=llm) CALL abort_gcm(TRIM(modname), 'Shape mismatch for "'//TRIM(var)//'"') + ALLOCATE(w(n(1), n(2), n(3), n(4)), v_glo(nh,nv)) CALL err(NF90_GET_VAR(fID, vID, w), "get", var) - ALLOCATE(v_glo(nh, nv)); v_glo = RESHAPE(w, [nh, nv]); DEALLOCATE(w) - IF(nh/=n_glo .OR. nv/=llm) CALL abort_gcm(TRIM(modname), 'Shape mismatch for "'//TRIM(var)//'"') - v(ib:ie,:) = v_glo(ib:ie,:) + v_glo(:,:) = RESHAPE(w, [nh, nv]); DEALLOCATE(w) + v(:,:) = v_glo(ib:ie,:) DEALLOCATE(v_glo) END SUBROUTINE get_var2 + + +LOGICAL FUNCTION is_rec(fID, did) RESULT(lrec) +!--- Check whether the file has a record dimension, detected as UNLIMITED diemnsion or using the attribute "units". + INTEGER, INTENT(IN) :: fID, did + INTEGER :: vid + CHARACTER(LEN=256) :: recn, ratt + !--- Check the "units" attribute of the last dimensional variable to detect record axis. + lrec = NF90_INQUIRE_DIMENSION (fID, did, name=recn) == NF90_NOERR + IF(lrec) lrec = NF90_INQ_VARID (fID, recn, vid) == NF90_NOERR + IF(lrec) lrec = NF90_GET_ATT (fID, vid, "units", ratt)== NF90_NOERR + IF(lrec) lrec = INDEX(ratt, " since ") /= 0 +END FUNCTION is_rec Index: LMDZ6/branches/LMDZ-tracers/libf/misc/readTracFiles_mod.f90 =================================================================== --- LMDZ6/branches/LMDZ-tracers/libf/misc/readTracFiles_mod.f90 (revision 3968) +++ LMDZ6/branches/LMDZ-tracers/libf/misc/readTracFiles_mod.f90 (revision 3985) @@ -106,5 +106,5 @@ !--- TELLS WHAT WAS IS ABOUT TO BE USED - IF(test(fmsg(fType==0, 'No adequate tracers description file(s) found ; default values will be used'), lerr)) RETURN + IF( fmsg(fType==0, 'No adequate tracers description file(s) found ; default values will be used')) RETURN CALL msg(fType==1, 'Trying to read old-style tracers description file "traceur.def"') CALL msg(fType==2, 'Trying to read the new style multi-sections tracers description file "tracer.def"') @@ -860,10 +860,11 @@ !--- REDUCE THE EXPRESSIONS TO OBTAIN SCALARS AND TRANSFER THEM TO THE "isot" ISOTOPES DESCRIPTORS VECTOR DO it = 1, SIZE(dBase(idb)%trac) - is = strIdx(isot(iis)%keys(:)%name, dBase(idb)%trac(it)%name) !--- Index of the "isot(iis)%keys(:)%name" tracer named "t%name" + t => dBase(idb)%trac(it) + is = strIdx(isot(iis)%keys(:)%name, t%name) !--- Index in "isot(iis)%keys(:)%name" of isotope "t%name" IF(is == 0) CYCLE - t => dBase(idb)%trac(it) liso = reduceExpr(t%keys%val, vals) !--- Reduce expressions (for substituted variables) - isot(iis)%keys(is)%key = PACK(t%keys%key, MASK=liso) - isot(iis)%keys(is)%val = PACK( vals, MASK=liso) + IF(test(ANY(liso), lerr)) RETURN !--- Some non-numerical elements were found + isot(iis)%keys(is)%key = PACK(t%keys%key, MASK=.NOT.liso) + isot(iis)%keys(is)%val = PACK( vals, MASK=.NOT.liso) END DO @@ -1228,12 +1229,16 @@ ELEMENTAL CHARACTER(LEN=256) FUNCTION delPhase(s) RESULT(out) CHARACTER(LEN=*), INTENT(IN) :: s - INTEGER :: l, i + INTEGER :: l, i, ix out = s - IF(s == '') RETURN - i = INDEX(s, '_'); l = LEN_TRIM(s) - IF(i == 0) THEN - IF(s(l-1:l-1)==phases_sep .AND. INDEX(known_phases,s(l:l)) /= 0) out = s(1:l-2) - ELSE; i=i-1 - 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) + IF(s == '') RETURN !--- Empty string: nothing to do + !--- Index of found phase in "known_phases" + ix = MAXLOC( [(i, i=1,nphases)], MASK=[( INDEX(s, phases_sep//known_phases(i:i))/=0, i=1, nphases)], DIM=1 ) + IF(ix == 0) RETURN !--- No phase pattern found + i = INDEX(s, phases_sep//known_phases(ix:ix)) !--- Index of pattern in "str" + l = LEN_TRIM(s) + IF(i == l-1) THEN !--- => return + out = s(1:l-2) + ELSE IF(s(i+2:i+2) == '_') THEN !--- _ => return _ + out = s(1:i-1)//s(i+2:l) END IF END FUNCTION delPhase @@ -1244,8 +1249,9 @@ INTEGER :: l, i out = s - IF(s == '') RETURN - i = INDEX(s, '_'); l = LEN_TRIM(s) - IF(i == 0) out = TRIM(s)//phases_sep//pha - IF(i /= 0) out = s(1:i-1)//phases_sep//pha//'_'//s(i+1:l) + IF(s == '') RETURN !--- Empty string: nothing to do + i = INDEX(s, '_') !--- /=0 for _ tracers names + l = LEN_TRIM(s) + IF(i == 0) out = TRIM(s)//phases_sep//pha !--- => return + IF(i /= 0) out = s(1:i-1)//phases_sep//pha//'_'//s(i+1:l) !--- _ => return _ END FUNCTION addPhase_1 !------------------------------------------------------------------------------------------------------------------------------ Index: LMDZ6/branches/LMDZ-tracers/libf/misc/strings_mod.F90 =================================================================== --- LMDZ6/branches/LMDZ-tracers/libf/misc/strings_mod.F90 (revision 3968) +++ LMDZ6/branches/LMDZ-tracers/libf/misc/strings_mod.F90 (revision 3985) @@ -187,4 +187,7 @@ !============================================================================================================================== !=== Extract the substring in front of the last (first if lFirst==TRUE) occurrence of separator "sep" in "str" ================ +!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect: ================ +!=== * strHead(..,.FALSE.) = 'a' ${str%%$sep*} ================ +!=== * strHead(..,.TRUE.) = 'a_b' ${str%$sep*} ================ !============================================================================================================================== CHARACTER(LEN=256) FUNCTION strHead_1(str,sep,lFirst) RESULT(out) @@ -215,8 +218,10 @@ out = [(strHead_1(str(k),lFirst=.NOT.lf), k=1, SIZE(str))] END IF - END FUNCTION strHead_m !============================================================================================================================== -!=== Extract the substring following the last (first if lFirst==TRUE) occurrence of separator "sep" in "str" ================== +!=== Extract the substring following the last (first if lFirst==TRUE) occurrence of separator "sep" in "str" ================ +!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect: ================ +!=== * strHead(..,.FALSE.) = 'b_c' ${str#*$sep} ================ +!=== * strHead(..,.TRUE.) = 'c' ${str##*$sep} ================ !============================================================================================================================== CHARACTER(LEN=256) FUNCTION strTail_1(str,sep,lFirst) RESULT(out) @@ -430,4 +435,5 @@ LOGICAL, OPTIONAL, INTENT(IN) :: lSc !--- Care about nbs with front sign or in scient. notation + INTEGER :: idx0 !--- Used to display an identified non-numeric string INTEGER, ALLOCATABLE :: ii(:) LOGICAL :: ll, ls @@ -435,25 +441,29 @@ ! modname = 'strIdx' lerr = .FALSE. - idx = strIdx1(rawList, del, ibeg, idel) - IF(.NOT.PRESENT(lSc)) RETURN !--- No need to check exceptions for numbers => finished - IF(.NOT. lSc ) RETURN !--- No need to check exceptions for numbers => finished + idx = strIdx1(rawList, del, ibeg, idel) !--- del(idel) appears in "rawList" at position idx + IF(.NOT.PRESENT(lSc)) RETURN !--- No need to check exceptions for numbers => finished + IF(.NOT. lSc ) RETURN !--- No need to check exceptions for numbers => finished + IF(idx == 0) THEN !--- No element of "del" in "rawList": + lerr = .NOT.is_numeric(rawList(ibeg:)) !--- String must be a number + IF(lerr) idx = LEN_TRIM(rawList); RETURN !--- Update idx => rawList(ibeg:idx-1) is the whole string + END IF + idx0 = idx + IF(test(idx==1.AND.INDEX('+-',del(idel))/=0, lerr)) RETURN !--- Front separator different from +/-: error + IF(idx/=1.AND.is_numeric(rawList(ibeg:idx-1))) RETURN !--- The input string tail is a valid number + idx = strIdx1(rawList, del, idx+1, idel) !--- => TO THE NEXT DELIMITER IF(idx == 0) THEN - lerr = .NOT.is_numeric(rawList(ibeg:)); RETURN !--- No separator detected: string must be a number - END IF - IF(test(idx==1.AND.INDEX('+-',del(idel))/=0, lerr)) RETURN !--- Front separator different from +/-: error - IF(is_numeric(rawList(ibeg:idx-1))) RETURN !--- The input string tail is a valid number - idx = strIdx1(rawList, del, idx+1, idel) !--- => TO THE NEXT DELIMITER + lerr = .NOT.is_numeric(rawList(ibeg:)) !--- No delimiter detected: string must be a number + IF(lerr) idx = idx0; RETURN + END IF + idx0 = idx + IF(is_numeric(rawList(ibeg:idx-1))) RETURN !--- The input string tail is a valid number + IF(test( INDEX('eE',rawList(idx-1:idx-1)) /= 0 & !--- Sole possible exception: scientific notation: E+/- + .OR. INDEX('+-',del(idel)) /=0, lerr)) RETURN + idx = strIdx1(rawList, del, idx+1, idel) !--- => TO THE NEXT DELIMITER IF(idx == 0) THEN - lerr = .NOT.is_numeric(rawList(ibeg:)); RETURN !--- No separator detected: string must be a number - END IF - IF(is_numeric(rawList(ibeg:idx-1))) RETURN !--- The input string tail is a valid number - IF(test( INDEX('eE',rawList(idx-1:idx-1)) /= 0 & !--- Sole possible exception: scientific notation: E+/- - .OR. INDEX('+-',del(idel)) /=0, lerr)) RETURN - idx = strIdx1(rawList, del, idx+1, idel) !--- => TO THE NEXT DELIMITER - IF(idx == 0) THEN - lerr = .NOT.is_numeric(rawList(ibeg:)); RETURN !--- No separator detected: string must be a number + lerr = .NOT.is_numeric(rawList(ibeg:)) !--- No separator detected: string must be a number + IF(lerr) idx = idx0; RETURN END IF lerr = .NOT.is_numeric(rawList(ibeg:idx-1)) - CONTAINS @@ -538,6 +548,6 @@ DO lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll) + IF(fmsg(lerr,'"'//TRIM(r(ib:ie-1))//'" is not numeric')) RETURN IF(jd == 0) EXIT - IF(fmsg(lerr,'"'//TRIM(r(ib:ie-1))//'" is not numeric')) RETURN ib = ie + LEN(delimiter(jd)) DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO !--- Skip spaces before next chain @@ -1117,5 +1127,5 @@ !=== Reduce an algebrical expression (basic operations and parenthesis) to a single number (string format) ==================== !============================================================================================================================== -LOGICAL FUNCTION reduceExpr_1(str, val) RESULT(out) +LOGICAL FUNCTION reduceExpr_1(str, val) RESULT(lerr) CHARACTER(LEN=*), INTENT(IN) :: str CHARACTER(LEN=256), INTENT(OUT) :: val @@ -1133,6 +1143,6 @@ ll = strCount(s,'(',nl) ll = strCount(s,')',nn) - out = nl == nn - IF(fmsg(.NOT.out, 'Mismatching number of opening and closing parenthesis: '//TRIM(s))) RETURN + lerr = nl /= nn + IF(fmsg(lerr, 'Mismatching number of opening and closing parenthesis: '//TRIM(s))) RETURN nl = 2*nl-1 @@ -1152,5 +1162,5 @@ DO WHILE(nl > 1) i = 1; DO WHILE(ip(i) /= 1 .OR. ip(i+1) /= 2); i = i + 1; END DO !IF(i > SIZE(ip)+1) EXIT;END DO - out = reduceExpr_basic(vl(i+1), v); IF(.NOT. out) RETURN + IF(test(reduceExpr_basic(vl(i+1), v), lerr)) RETURN v = TRIM(vl(i))//TRIM(v); IF(i+2<=nl) v=TRIM(v)//TRIM(vl(i+2)) vv = v//REPEAT(' ',768) @@ -1160,5 +1170,5 @@ nl = SIZE(vl) END DO - out = reduceExpr_basic(vl(1), val) + lerr = reduceExpr_basic(vl(1), val) END FUNCTION reduceExpr_1 @@ -1167,5 +1177,5 @@ !=== Reduce a simple algebrical expression (basic operations, no parenthesis) to a single number (string format) ============== !============================================================================================================================== -LOGICAL FUNCTION reduceExpr_basic(str, val) RESULT(out) +LOGICAL FUNCTION reduceExpr_basic(str, val) RESULT(lerr) CHARACTER(LEN=*), INTENT(IN) :: str CHARACTER(LEN=*), INTENT(OUT) :: val @@ -1178,15 +1188,14 @@ DOUBLE PRECISION :: v, vm, vp INTEGER :: i, ni, io - LOGICAL :: ll ! modname = 'reduceExpr_basic' - out = .TRUE. + lerr = .FALSE. IF(is_numeric(str)) THEN; val=TRIM(str); RETURN; END IF op = ['^','/','*','+','-'] !--- List of recognized operations s = str - ll = strParse_m(s, op, ky, .TRUE., id = id) !--- Parse the values + IF(test(strParse_m(s, op, ky, .TRUE., id = id), lerr)) RETURN !--- Parse the values vl = str2dble(ky) !--- Conversion to doubles - out = ALL(vl < HUGE(1.d0)) - IF(fmsg(.NOT.out,'Some values are non-numeric in: '//TRIM(s))) RETURN !--- Non-numerical values found + lerr = ANY(vl >= HUGE(1.d0)) + IF(fmsg(lerr,'Some values are non-numeric in: '//TRIM(s))) RETURN !--- Non-numerical values found DO io = 1, SIZE(op) !--- Loop on known operators (order matters !) DO i = SIZE(id), 1, -1 !--- Loop on found operators @@ -1211,11 +1220,11 @@ !============================================================================================================================== -FUNCTION reduceExpr_m(str, val) RESULT(out) - LOGICAL, ALLOCATABLE :: out(:) +FUNCTION reduceExpr_m(str, val) RESULT(lerr) + LOGICAL, ALLOCATABLE :: lerr(:) CHARACTER(LEN=*), INTENT(IN) :: str(:) CHARACTER(LEN=256), ALLOCATABLE, INTENT(OUT) :: val(:) INTEGER :: i - ALLOCATE(out(SIZE(str)),val(SIZE(str))) - out(:) = [(reduceExpr_1(str(i), val(i)), i=1, SIZE(str))] + ALLOCATE(lerr(SIZE(str)),val(SIZE(str))) + lerr(:) = [(reduceExpr_1(str(i), val(i)), i=1, SIZE(str))] END FUNCTION reduceExpr_m !============================================================================================================================== @@ -1230,4 +1239,5 @@ INTEGER :: e CHARACTER(LEN=12) :: fmt + IF(TRIM(str) == '') THEN; out = .FALSE.; RETURN; END IF WRITE(fmt,'("(f",i0,".0)")') LEN_TRIM(str) READ(str,fmt,IOSTAT=e) x Index: LMDZ6/branches/LMDZ-tracers/libf/phylmd/infotrac_phy.F90 =================================================================== --- LMDZ6/branches/LMDZ-tracers/libf/phylmd/infotrac_phy.F90 (revision 3968) +++ LMDZ6/branches/LMDZ-tracers/libf/phylmd/infotrac_phy.F90 (revision 3985) @@ -3,5 +3,5 @@ USE strings_mod, ONLY: msg, fmsg, test, strIdx, int2str - USE readTracFiles_mod, ONLY: getKey_init, getKey, indexUpdate, delPhase + USE readTracFiles_mod, ONLY: getKey_init, getKey, indexUpdate, delPhase, phases_sep, known_phases, nphases USE trac_types_mod, ONLY: tra, iso, kys @@ -158,4 +158,5 @@ CHARACTER(LEN=256) :: modname="init_infotrac_phy" + INTEGER :: iq LOGICAL :: lerr @@ -188,19 +189,11 @@ #ifdef CPP_StratAer IF (type_trac == 'coag') THEN - nbtr_bin=0 - nbtr_sulgas=0 - DO iq = 1, nqtrue - IF(tracers(iq)%name(1:3)=='BIN') nbtr_bin = nbtr_bin +1 - IF(tracers(iq)%name(1:3)=='GAS') nbtr_sulgas = nbtr_sulgas+1 - SELECT CASE(tracers(iq)%name) - CASE('BIN01'); id_BIN01_strat = iq - nqo; CALL msg('id_BIN01_strat=', id_BIN01_strat) - CASE('GASOCS'); id_OCS_strat = iq - nqo; CALL msg('id_OCS_strat =', id_OCS_strat) - CASE('GASSO2'); id_SO2_strat = iq - nqo; CALL msg('id_SO2_strat =', id_SO2_strat) - CASE('GASH2SO4'); id_H2SO4_strat = iq - nqo; CALL msg('id_H2SO4_strat=', id_H2SO4_strat) - CASE('GASTEST'); id_TEST_strat = iq - nqo; CALL msg('id_TEST_strat =', id_TEST_strat) - END SELECT - END DO - CALL msg('nbtr_bin =',nbtr_bin) - CALL msg('nbtr_sulgas =',nbtr_sulgas) + nbtr_bin = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)]); CALL msg('nbtr_bin =', nbtr_bin) + nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)]); CALL msg('nbtr_sulgas =', nbtr_sulgas) + id_BIN01_strat = MAX(0, strIdx(tracers(:)%name, 'BIN01' ) - nqo); CALL msg('id_BIN01_strat =', id_BIN01_strat) + id_OCS_strat = MAX(0, strIdx(tracers(:)%name, 'GASOSC' ) - nqo); CALL msg('id_OCS_strat =', id_OCS_strat) + id_SO2_strat = MAX(0, strIdx(tracers(:)%name, 'GASSO2' ) - nqo); CALL msg('id_SO2_strat =', id_SO2_strat) + id_H2SO4_strat = MAX(0, strIdx(tracers(:)%name, 'GASH2SO4') - nqo); CALL msg('id_H2SO4_strat =', id_H2SO4_strat) + id_TEST_strat = MAX(0, strIdx(tracers(:)%name, 'GASTEST' ) - nqo); CALL msg('id_TEST_strat =', id_TEST_strat) END IF #endif