Index: LMDZ6/trunk/libf/dyn3d_common/infotrac.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d_common/infotrac.F90 (revision 4066) +++ LMDZ6/trunk/libf/dyn3d_common/infotrac.F90 (revision 4067) @@ -3,9 +3,10 @@ MODULE infotrac - USE strings_mod, ONLY: msg, find, strIdx, strFind, strParse, dispTable, int2str, reduceExpr, & - cat, fmsg, test, strTail, strHead, strStack, strReduce, bool2str, maxlen, testFile + USE strings_mod, ONLY: msg, find, strIdx, strFind, strParse, dispTable, int2str, reduceExpr, & + cat, fmsg, test, strTail, strHead, strStack, strReducef, bool2str, maxlen, testFile USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, addPhase, phases_sep, nphases, ancestor, & isot_type, readIsotopesFile, delPhase, old_phases, getKey_init, tran0, & - keys_type, initIsotopes, indexUpdate, known_phases, getKey, setGeneration + keys_type, initIsotopes, indexUpdate, known_phases, getKey, setGeneration, & + new2oldPhase IMPLICIT NONE @@ -225,5 +226,5 @@ descrq(30) = 'PRA' - CALL msg('type_trac='//TRIM(type_trac), modname) + CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) IF(lOldCode) THEN str = [type_trac]; nt = 1 @@ -377,14 +378,12 @@ tracers(:)%phase = 'g' tracers(:)%component = type_trac - DO ip = 1, nphases - p = old_phases(ip:ip) - iq = strIdx(tracers(:)%name, 'H2O'//p) - IF(iq /= 0) CYCLE - tracers(iq)%phase = p + DO iq = 1, nqtrue IF(lINCA) tracers(iq)%component = 'lmdz' + ip = strIdx([('H2O'//old_phases(ix:ix), ix=1, nphases)], strHead(tracers(iq)%name,'_')) + IF(ip == 0) CYCLE + tracers(iq)%phase = known_phases(ip:ip) END DO IF(lINCA) tracers(1+nqo:nqCO2+nqo)%component = 'co2i' CALL setGeneration(tracers) !--- SET FIELDS %iGeneration, %gen0Name - ! manque "type" @@ -709,10 +708,11 @@ IMPLICIT NONE CHARACTER(LEN=3) :: tnom_iso(niso_possibles) - INTEGER, ALLOCATABLE :: nb_iso(:,:), nb_traciso(:,:) - INTEGER :: ii, ip, iq, it, iz, ixt, nb_isoind, nzone_prec + INTEGER, ALLOCATABLE :: nb_iso(:,:), nb_traciso(:,:), nb_isoind(:) + INTEGER :: ii, ip, iq, it, iz, ixt, nzone_prec TYPE(isot_type), POINTER :: i TYPE(trac_type), POINTER :: t(:) CHARACTER(LEN=maxlen) :: tnom_trac CHARACTER(LEN=maxlen), ALLOCATABLE :: str(:) + LOGICAL, DIMENSION(:), ALLOCATABLE :: mask INCLUDE "iniprint.h" @@ -723,4 +723,5 @@ ALLOCATE(indnum_fn_num(niso_possibles)) ALLOCATE(iso_indnum(nqtot)) + ALLOCATE(nb_isoind(nqo)) iso_indnum (:) = 0 @@ -729,18 +730,18 @@ nb_iso (:,:) = 0 nb_traciso (:,:) = 0 + nb_isoind (:) = 0 DO iq=1, nqtot IF(delPhase(tracers(iq)%name) == 'H2O' .OR. .NOT.tracers(iq)%isAdvected) CYCLE outer:DO ip = 1, nqo - nb_isoind = 0 DO ixt= 1,niso_possibles tnom_trac = 'H2O'//old_phases(ip:ip)//'_'//TRIM(tnom_iso(ixt)) IF (tracers(iq)%name == tnom_trac) THEN nb_iso(ixt,ip) = nb_iso(ixt,ip)+1 - nb_isoind = nb_isoind+1 + nb_isoind (ip) = nb_isoind (ip)+1 tracers(iq)%type = 'tracer' tracers(iq)%iso_iGroup = 1 tracers(iq)%iso_iName = ixt - iso_indnum(iq) = nb_isoind + iso_indnum(iq) = nb_isoind(ip) indnum_fn_num(ixt) = iso_indnum(iq) tracers(iq)%iso_iPhase = ip @@ -748,7 +749,7 @@ ELSE IF(tracers(iq)%iqParent> 0) THEN IF(tracers(tracers(iq)%iqParent)%name == tnom_trac) THEN - nb_traciso(ixt,ip) = nb_traciso(ixt,ip)+1 + nb_traciso(ixt,ip) = nb_traciso(ixt,ip)+1 iso_indnum(iq) = indnum_fn_num(ixt) - tracers(iq)%type = 'tag' + tracers(iq)%type = 'tag' tracers(iq)%iso_iGroup = 1 tracers(iq)%iso_iName = ixt @@ -814,16 +815,33 @@ ALLOCATE(isotopes(1)) !--- Only water nbIso = 1 + t => tracers i => isotopes(1) - t => tracers - str = PACK(delPhase(t%name), MASK = t%type=='tracer' .AND. delPhase(t%parent) == 'H2O' .AND. t%phase == 'g') i%parent = 'H2O' - i%niso = SIZE(str) + + !--- Isotopes names list (embedded in the "keys" field) + i%niso = niso + ALLOCATE(i%keys(i%niso)) + mask = t%type=='tracer' .AND. delPhase(t%gen0Name)=='H2O' .AND. t%phase == 'g' .AND. t%iGeneration==1 + i%keys(:)%name = strReducef(strTail(PACK(delPhase(t%name), MASK = mask), '_')) + + !--- Full isotopes list, with isotopes tagging tracers (if any) following the previous list + i%ntiso = ntiso; ALLOCATE(i%trac(i%ntiso)) + mask = t%type=='tag' .AND. delPhase(t%gen0Name)=='H2O' .AND. t%phase == 'g' .AND. t%iGeneration==2 + i%trac(:) = [i%keys(:)%name, strReducef(PACK(delPhase(t%name), MASK = mask))] + + !--- Tagging zones names list i%nzone = nzone + i%zone = strTail(str, '_', .TRUE.) + + !--- Effective phases list i%nphas = nqo - FORALL(it = 1:i%niso) i%keys(it)%name = str(it) - i%zone = PACK(strTail(t%name,'_',.TRUE.), MASK = t%type=='tag' .AND. delPhase(t%gen0Name)=='H2O' .AND. t%iGeneration==3) - CALL strReduce(i%zone) - i%phase = strStack([(known_phases(ip:ip), ip=1, nphases)], MASK=[(strIdx(t%name,addPhase('H2O',known_phases(ip:ip)))/=0)]) - i%iTraPha = RESHAPE([((strIdx(t(:)%name,addPhase(i%trac(it),i%phase(ip:ip))) ,it=1,i%ntiso),ip=1,i%nphas)],[i%ntiso,i%nphas]) + i%phase = '' + DO ip=1,nphases; IF(strIdx(t%name, addPhase('H2O',old_phases(ip:ip),''))/=0) i%phase=TRIM(i%phase)//known_phases(ip:ip); END DO + + !--- Table: index in "qx" of an isotope, knowing its indices "it","ip" in "isotope%iName,%iPhase" + i%iTraPha = RESHAPE([((strIdx(t%name, TRIM(addPhase('H2O', new2oldPhase(i%phase(ip:ip)), ''))//'_'//TRIM(i%trac(it))), & + it=1,i%ntiso), ip=1,i%nphas)], [i%ntiso,i%nphas]) + + !--- Table: index in "isotope%tracs(:)%name" of an isotopic tagging tracer, knowing its indices "iz","ip" in "isotope%iZone,%iName" i%iZonIso = RESHAPE([((strIdx(i%trac,TRIM(i%trac(it))//'_'//TRIM(i%zone(iz))),iz=1,i%nzone),it=1,i%niso )],[i%nzone,i%niso ]) DO it=1,ntiso Index: LMDZ6/trunk/libf/misc/readTracFiles_mod.f90 =================================================================== --- LMDZ6/trunk/libf/misc/readTracFiles_mod.f90 (revision 4066) +++ LMDZ6/trunk/libf/misc/readTracFiles_mod.f90 (revision 4067) @@ -15,5 +15,6 @@ PUBLIC :: known_phases, old_phases, nphases, phases_names, & !--- VARIABLES RELATED TO THE PHASES - phases_sep, delPhase, addPhase !--- + ROUTINES TO ADD/REMOVE PHASE TO/FROM A NAME + phases_sep, delPhase, addPhase, & !--- + ROUTINES TO ADD/REMOVE PHASE TO/FROM A NAME + old2newPhase, new2oldPhase PUBLIC :: tran0, idxAncestor, ancestor !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS @@ -1255,9 +1256,11 @@ CHARACTER(LEN=*), INTENT(IN) :: s INTEGER :: l, i, ix + CHARACTER(LEN=maxlen) :: sh, st out = s IF(s == '') RETURN !--- Empty string: nothing to do !--- Special case: old phases for water, no phases separator - IF(ANY([('H2O'//old_phases(ix:ix), ix=1, nphases)] == s)) THEN; out='H2O'; RETURN; END IF + i = INDEX(s,'_'); sh = s; IF(i/=0) sh=s(1:i-1); st='H2O'; IF(i/=0) st='H2O_'//s(i+1:LEN_TRIM(s)) + IF(ANY([('H2O'//old_phases(ix:ix), ix=1, nphases)] == sh)) THEN; out=st; RETURN; END IF !--- Index of found phase in "known_phases" @@ -1300,4 +1303,13 @@ !------------------------------------------------------------------------------------------------------------------------------ +CHARACTER(LEN=1) FUNCTION old2newPhase(op) RESULT(np) + CHARACTER(LEN=1), INTENT(IN) :: op + np = known_phases(INDEX(old_phases,op):INDEX(old_phases,op)) +END FUNCTION old2newPhase + +CHARACTER(LEN=1) FUNCTION new2oldPhase(np) RESULT(op) + CHARACTER(LEN=1), INTENT(IN) :: np + op = old_phases(INDEX(known_phases,np):INDEX(known_phases,np)) +END FUNCTION new2oldPhase !============================================================================================================================== Index: LMDZ6/trunk/libf/misc/strings_mod.F90 =================================================================== --- LMDZ6/trunk/libf/misc/strings_mod.F90 (revision 4066) +++ LMDZ6/trunk/libf/misc/strings_mod.F90 (revision 4067) @@ -5,6 +5,6 @@ PRIVATE PUBLIC :: maxlen, init_printout, msg, fmsg, get_in, lunout, prt_level - PUBLIC :: strLower, strHead, strStack, strClean, strIdx, strCount, strReplace - PUBLIC :: strUpper, strTail, strStackm, strReduce, strFind, strParse, cat, find + PUBLIC :: strLower, strHead, strStack, strReduce, strClean, strFind, strIdx, find + PUBLIC :: strUpper, strTail, strStackm, strReducef, strParse, strCount, strReplace, cat PUBLIC :: dispTable, dispOutliers, dispNameList PUBLIC :: is_numeric, bool2str, int2str, real2str, dble2str @@ -343,15 +343,10 @@ !=== strReduce_2(str1,str2): Append str1 with new elements of str2. =========================================================== !============================================================================================================================== -SUBROUTINE strReduce_1(str1, nb) - CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str1(:) +SUBROUTINE strReduce_1(str, nb) + CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:) INTEGER, OPTIONAL, INTENT(OUT) :: nb CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:) - INTEGER :: k, n, n1 - IF(PRESENT(nb)) nb = 0 - CALL MOVE_ALLOC(FROM = str1, TO = s1); CALL strClean(s1) - n1 = SIZE(s1, DIM=1) !--- Total nb of elements in "s1" - n = COUNT( [( ALL(s1(1:k-1)/=s1(k)), k=1, n1 )] ) !--- Nb of unique elements in "s1" - ALLOCATE(str1(n)); IF(n==0) RETURN; str1(1) = s1(1) - n=1; DO k=2,n1; IF(ANY(s1(1:k-1)==s1(k))) CYCLE; n=n+1; str1(n)=s1(k); END DO + INTEGER :: n + s1 = strReducef(str, n); CALL MOVE_ALLOC(FROM=s1, TO=str) IF(PRESENT(nb)) nb = n END SUBROUTINE strReduce_1 @@ -375,4 +370,19 @@ END IF END SUBROUTINE strReduce_2 +!============================================================================================================================== +FUNCTION strReducef(str_in, nb) RESULT(str_ou) + CHARACTER(LEN=*), INTENT(IN) :: str_in(:) + INTEGER, OPTIONAL, INTENT(OUT) :: nb + CHARACTER(LEN=LEN(str_in)), ALLOCATABLE :: str_ou(:) + CHARACTER(LEN=LEN(str_in)), ALLOCATABLE :: s1(:) + INTEGER :: k, n, n1 + IF(PRESENT(nb)) nb = 0 + s1 = str_in; CALL strClean(s1) + n1 = SIZE(s1, DIM=1) !--- Total nb of elements in "s1" + n = COUNT( [( ALL(s1(1:k-1)/=s1(k)), k=1, n1 )] ) !--- Nb of unique elements in "s1" + ALLOCATE(str_ou(n)); IF(n==0) RETURN; str_ou(1) = s1(1) + n=1; DO k=2,n1; IF(ANY(s1(1:k-1)==s1(k))) CYCLE; n=n+1; str_ou(n)=s1(k); END DO + IF(PRESENT(nb)) nb = n +END FUNCTION strReducef !============================================================================================================================== Index: LMDZ6/trunk/libf/phylmd/physiq_mod.F90 =================================================================== --- LMDZ6/trunk/libf/phylmd/physiq_mod.F90 (revision 4066) +++ LMDZ6/trunk/libf/phylmd/physiq_mod.F90 (revision 4067) @@ -2270,5 +2270,5 @@ itr = 0 DO iq = 1, nqtot - IF(tracers(iq)%isH2Ofamily) CYCLE + IF(tracers(iq)%isH2Ofamily .OR. .NOT.tracers(iq)%isAdvected) CYCLE itr = itr+1 DO k = 1, klev