Ignore:
Timestamp:
Apr 20, 2020, 12:13:34 PM (5 years ago)
Author:
lfalletti
Message:

Adding changes for Reprobus

Location:
LMDZ6/trunk/libf/phylmd
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/phys_output_ctrlout_mod.F90

    r3622 r3666  
    17761776  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_trac(:)
    17771777  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_trac_cum(:)
    1778 #ifdef REPROBUS
    1779   TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_nas(:)
    1780 #endif
    17811778  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_vdf(:)
    17821779  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_the(:)

  • LMDZ6/trunk/libf/phylmd/phys_output_mod.F90

    r3630 r3666  
    4646    USE vertical_layers_mod, ONLY: ap,bp,preff,presnivs, aps, bps, pseudoalt
    4747    USE time_phylmdz_mod, ONLY: day_ini, itau_phy, start_time, annee_ref, day_ref
    48 #ifdef REPROBUS
    49     USE chem_rep, ONLY: nbnas, tnamenas, ttextnas
    50 #endif
    5148#ifdef CPP_XIOS
    5249    ! ug Pour les sorties XIOS
    … …  
    160157    IF (.NOT. ALLOCATED(o_trac)) ALLOCATE(o_trac(nqtot))
    161158    IF (.NOT. ALLOCATED(o_trac_cum)) ALLOCATE(o_trac_cum(nqtot))
    162 #ifdef REPROBUS
    163     IF (.NOT. ALLOCATED(o_nas)) ALLOCATE(o_nas(nbnas))
    164 #endif
    165159    ALLOCATE(o_dtr_the(nqtot),o_dtr_con(nqtot),o_dtr_lessi_impa(nqtot))
    166160    ALLOCATE(o_dtr_lessi_nucl(nqtot),o_dtr_insc(nqtot),o_dtr_bcscav(nqtot))
    … …  
    581575            ENDDO
    582576      ENDIF
    583       IF (type_trac=='repr') THEN
    584 #ifdef REPROBUS
    585          DO iiq=1,nbnas
    586             o_nas(iiq) = ctrl_out((/ 4, 5, 5, 5, 10, 10, 11, 11, 11, 11 /), &
    587                  tnamenas(iiq),ttextnas(iiq), "-", &
    588                  (/ '', '', '', '', '', '', '', '', '', '' /))
    589          ENDDO
    590 #endif
    591       ENDIF
    592577
    593578   ENDDO !  iff

  • LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90

    r3630 r3666  
    172172         o_uxv, o_vxq, o_vxT, o_wxq, o_vxphi, &
    173173         o_wxT, o_uxu, o_vxv, o_TxT, o_trac, &
    174 #ifdef REPROBUS
    175          o_nas, &
    176 #endif
    177174         o_dtr_vdf, o_dtr_the, o_dtr_con, &
    178175         o_dtr_lessi_impa, o_dtr_lessi_nucl, &
    … …  
    331328         surf_PM25_sulf, tau_strat_550, tausum_strat, &
    332329         vsed_aer, tau_strat_1020, f_r_wet
    333 #endif
    334 
    335 #ifdef REPROBUS
    336     USE CHEM_REP, ONLY : nas, nbnas, tnamenas, ttextnas
    337330#endif
    338331
    … …  
    22672260!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    22682261       IF (iflag_phytrac == 1 ) then
    2269          IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag') THEN
     2262         IF (type_trac == 'lmdz' .OR. type_trac == 'coag') THEN
    22702263           DO iq=nqo+1, nqtot
    22712264             !--3D fields
    … …  
    22922285                ENDDO
    22932286             ENDIF
    2294 #ifndef REPROBUS
    22952287             CALL histwrite_phy(o_trac_cum(iq-nqo), zx_tmp_fi2d)
    2296 #endif
    22972288           ENDDO !--iq
    22982289         ENDIF   !--type_trac
    … …  
    23222313         ENDIF !--type_trac co2i
    23232314
    2324          IF (type_trac == 'repr') THEN
    2325 #ifdef REPROBUS
    2326            DO iq=1,nbnas
    2327              CALL histwrite_phy(o_nas(iq), nas(:,:,iq))
    2328            ENDDO
    2329 #endif
    2330          ENDIF
    2331 
    23322315       ENDIF   !(iflag_phytrac==1)
    23332316

  • LMDZ6/trunk/libf/phylmd/physiq_mod.F90

    r3632 r3666  
    246246#endif
    247247#ifdef REPROBUS
    248     USE CHEM_REP, ONLY : Init_chem_rep_xjour
     248    USE CHEM_REP, ONLY : Init_chem_rep_xjour, &
     249         d_q_rep,d_ql_rep,d_qi_rep,ptrop,ttrop, &
     250         ztrop, gravit,itroprep, Z1,Z2,fac,B
    249251#endif
    250252    USE indice_sol_mod
    … …  
    19501952#endif
    19511953       ENDIF
     1954       IF (type_trac == 'repr') THEN
     1955#ifdef REPROBUS
     1956          CALL chemini_rep(  &
     1957               presnivs, &
     1958               pdtphys, &
     1959               annee_ref, &
     1960               day_ref,  &
     1961               day_ini, &
     1962               start_time, &
     1963               itau_phy, &
     1964               io_lon, &
     1965               io_lat)
     1966#endif
     1967       ENDIF
    19521968
    19531969       !$omp single
    … …  
    22862302
    22872303          wo(:,:,1)=ozonecm(latitude_deg, paprs,read_climoz,rjour=zzz)
     2304#ifdef REPROBUS
     2305          ptrop=dyn_tropopause(t_seri, ztsol, paprs, pplay, rot)/100.
     2306          DO i = 1, klon
     2307             Z1=t_seri(i,itroprep(i)+1)
     2308             Z2=t_seri(i,itroprep(i))
     2309             fac=(Z1-Z2)/alog(pplay(i,itroprep(i)+1)/pplay(i,itroprep(i)))
     2310             B=Z2-fac*alog(pplay(i,itroprep(i)))
     2311             ttrop(i)= fac*alog(ptrop(i))+B
     2312!       
     2313             Z1= 1.e-3 * ( pphi(i,itroprep(i)+1)+pphis(i) ) / gravit
     2314             Z2= 1.e-3 * ( pphi(i,itroprep(i))  +pphis(i) ) / gravit
     2315             fac=(Z1-Z2)/alog(pplay(i,itroprep(i)+1)/pplay(i,itroprep(i)))
     2316             B=Z2-fac*alog(pplay(i,itroprep(i)))
     2317             ztrop(i)=fac*alog(ptrop(i))+B
     2318          ENDDO
     2319#endif
    22882320       ELSE
    22892321          !--- ro3i = elapsed days number since current year 1st january, 0h
    … …  
    37543786#endif
    37553787    ENDIF !type_trac = inca
    3756 
     3788    IF (type_trac == 'repr') THEN
     3789#ifdef REPROBUS
     3790    !CALL chemtime_rep(itap+itau_phy-1, date0, dtime, itap)
     3791    CALL chemtime_rep(itap+itau_phy-1, date0, phys_tstep, itap)
     3792#endif
     3793    ENDIF
    37573794
    37583795    !
    … …  
    47194756
    47204757    IF (type_trac=='repr') THEN
     4758!MM pas d'impact, car on recupere q_seri,tr_seri,t_seri via phys_local_var_mod
     4759!MM                               dans Reprobus
    47214760       sh_in(:,:) = q_seri(:,:)
     4761#ifdef REPROBUS
     4762       d_q_rep(:,:) = 0.
     4763       d_ql_rep(:,:) = 0.
     4764       d_qi_rep(:,:) = 0.
     4765#endif
    47224766    ELSE
    47234767       sh_in(:,:) = qx(:,:,ivap)
    … …  
    47694813         d_tr_dyn, &                                 !<<RomP
    47704814         tr_seri, init_source)
     4815#ifdef REPROBUS
     4816
     4817
     4818          print*,'avt add phys rep',abortphy
     4819
     4820     CALL add_phys_tend &
     4821            (du0,dv0,dt0,d_q_rep,d_ql_rep,d_qi_rep,paprs,&
     4822             'rep',abortphy,flag_inhib_tend,itap,0)
     4823        IF (abortphy==1) Print*,'ERROR ABORT REP'
     4824
     4825          print*,'apr add phys rep',abortphy
     4826
     4827#endif
     4828
    47714829#endif
    47724830    ENDIF    ! (iflag_phytrac=1)

  • LMDZ6/trunk/libf/phylmd/radiation_AR4.F90

    r2346 r3666  
    482482#ifdef REPROBUS
    483483  USE chem_rep, ONLY: rsuntime, ok_suntime
     484  USE print_control_mod, ONLY: lunout
    484485#endif
    485486

  • LMDZ6/trunk/libf/phylmd/radlwsw_m.F90

    r3630 r3666  
    453453  IF (type_trac == 'repr') THEN
    454454#ifdef REPROBUS
    455      if(ok_SUNTIME) PSCT = solaireTIME/zdist/zdist
    456      print*,'Constante solaire: ',PSCT*zdist*zdist
     455    IF (iflag_rrtm==0) THEN
     456      if(ok_SUNTIME) PSCT = solaireTIME/zdist/zdist
     457      print*,'Constante solaire: ',PSCT*zdist*zdist
     458    END IF
    457459#endif
    458460  END IF

  • LMDZ6/trunk/libf/phylmd/rrtm/lwu.F90

    r2027 r3666  
    7474!USE YOERDI   , ONLY : RCH4     ,RN2O     ,RCFC11   ,RCFC12
    7575USE YOERDU   , ONLY : R10E     ,REPSCO   ,REPSCQ
     76#ifdef REPROBUS
     77USE chem_rep, ONLY: rch42d, rn2o2d, rcfc112d, rcfc122d, ok_rtime2d
     78USE infotrac_phy, ONLY : type_trac
     79#endif
    7680
    7781
    … …  
    316320      PABCU(JL,17,IC)=PABCU(JL,17,ICP1)+ ZUAER(JL,4)    *ZDUC(JL,IC)*ZDIFF
    317321      PABCU(JL,18,IC)=PABCU(JL,18,ICP1)+ ZUAER(JL,5)    *ZDUC(JL,IC)*ZDIFF
     322#ifdef REPROBUS
     323        IF (type_trac=='repr'.and. ok_rtime2d) THEN
     324!- CH4
     325      PABCU(JL,19,IC)=PABCU(JL,19,ICP1)&
     326       & + ZABLY(JL,2,IC)*RCH42D(JL, IC)/PCCO2*ZPHM6(JL)*ZDIFF
     327      PABCU(JL,20,IC)=PABCU(JL,20,ICP1)&
     328       & + ZABLY(JL,3,IC)*RCH42D(JL, IC)/PCCO2*ZPSM6(JL)*ZDIFF
     329!- N2O
     330      PABCU(JL,21,IC)=PABCU(JL,21,ICP1)&
     331       & + ZABLY(JL,2,IC)*RN2O2D(JL, IC)/PCCO2*ZPHN6(JL)*ZDIFF
     332      PABCU(JL,22,IC)=PABCU(JL,22,ICP1)&
     333       & + ZABLY(JL,3,IC)*RN2O2D(JL, IC)/PCCO2*ZPSN6(JL)*ZDIFF
     334!- CFC11
     335      PABCU(JL,23,IC)=PABCU(JL,23,ICP1)&
     336       & + ZABLY(JL,2,IC)*RCFC112D(JL, IC)/PCCO2        *ZDIFF
     337!- CFC12
     338      PABCU(JL,24,IC)=PABCU(JL,24,ICP1)&
     339       & + ZABLY(JL,2,IC)*RCFC122D(JL, IC)/PCCO2        *ZDIFF
     340
     341         ELSE
     342#endif
    318343!- CH4
    319344      PABCU(JL,19,IC)=PABCU(JL,19,ICP1)&
    … …  
    332357      PABCU(JL,24,IC)=PABCU(JL,24,ICP1)&
    333358       & + ZABLY(JL,2,IC)*RCFC12/PCCO2        *ZDIFF 
     359#ifdef REPROBUS
     360        END IF
     361#endif
    334362    ENDDO
    335363  ENDDO

  • LMDZ6/trunk/libf/phylmd/tracreprobus_mod.F90

    r3125 r3666  
    1616    USE CHEM_REP, ONLY : pdt_rep, &  ! pas de temps reprobus
    1717         daynum, iter, &             ! jourjulien, iteration chimie
    18          pdel
     18         pdel,&
     19         d_q_rep,d_ql_rep,d_qi_rep
    1920#endif
    2021    IMPLICIT NONE
    … …  
    4647! Local variables
    4748!----------------
    48     INTEGER :: it, k
     49    INTEGER :: it, k, niter
    4950
    5051#ifdef REPROBUS
    5152    !   -- CHIMIE REPROBUS --
    52     pdt_rep=pdtphys/2.
     53!    pdt_rep=pdtphys/2.
     54    niter=pdtphys/pdt_rep
     55    write(*,*)'nb d appel de REPROBUS',niter
    5356   
    5457    DO k = 1, klev
    … …  
    6063       tr_seri(:,:,11)=tr_seri(:,:,8)
    6164    END IF
     65
     66    d_q_rep(:,:)  =0.
     67    d_ql_rep(:,:) =0.
     68    d_qi_rep(:,:) =0.
    6269   
    63     DO  iter = 1,2
     70    DO  iter = 1,niter
    6471       daynum = FLOAT(julien) + gmtime + (iter-1)*pdt_rep/86400.
    6572       
    66        DO it=1, nbtr
     73!       DO it=1, nbtr
    6774!     WRITE(lunout,*)it,' ',minval(tr_seri(:,:,it)),maxval(tr_seri(:,:,it))
    6875! seulement pour les especes chimiques (pas l'age de l'air)
    … …  
    7077! correction: a 1.e-30 quand =0 ou negatif et
    7178! call abort si >ou= 1.e10
    72           WRITE(*,*)it,'nqtot',nqtot,'nbtr',nbtr
    73           IF (it < nqtot) THEN
    74              WRITE(*,*)'iciav',it,nqtot
    75 #ifdef REPROBUS
    76              CALL minmaxqfi_chimie(it,tr_seri(1,1,it),0.,1.e10,'avant chimie ')
    77 #endif
    78              WRITE(*,*)iter,'avpres'
    79           ENDIF
    80        ENDDO
     79!          WRITE(*,*)it,'nqtot',nqtot,'nbtr',nbtr
     80!          IF (it < nqtot) THEN
     81!             WRITE(*,*)'iciav',it,nqtot
     82!#ifdef REPROBUS
     83!             CALL minmaxqfi_chimie(it,tr_seri(1,1,it),0.,1.e10,'avant chimie ')
     84!#endif
     85!             WRITE(*,*)iter,'avpres'
     86!          ENDIF
     87!       ENDDO
    8188       
    8289#ifdef REPROBUS
    … …  
    95102       !                 et transporte par CHEM_REP
    96103
    97        DO it=1, nbtr
     104!       DO it=1, nbtr
    98105!     WRITE(lunout,*)it,' ',minval(tr_seri(:,:,it)),maxval(tr_seri(:,:,it))
    99106! seulement pour les especes chimiques (pas l'age de l'air)
    … …  
    101108! correction: a 1.e-30 quand =0 ou negatif et
    102109! call abort si >ou= 1.e10
    103           WRITE(*,*)it,'nqtot',nqtot,'nbtr',nbtr
    104           IF (it < nqtot) THEN
    105              WRITE(*,*)'iciap',it,nqtot
    106              CALL minmaxqfi_chimie(it,tr_seri(1,1,it),0.,1.e10,'apres chemmain')
    107              WRITE(*,*)iter,'appres'
    108           ENDIF
    109        ENDDO
     110!          WRITE(*,*)it,'nqtot',nqtot,'nbtr',nbtr
     111!          IF (it < nqtot) THEN
     112!             WRITE(*,*)'iciap',it,nqtot
     113!             CALL minmaxqfi_chimie(it,tr_seri(1,1,it),0.,1.e10,'apres chemmain')
     114!             WRITE(*,*)iter,'appres'
     115!          ENDIF
     116!       ENDDO
    110117
    111118#endif       

  • LMDZ6/trunk/libf/phylmd/tropopause_m.F90

    r3141 r3666  
    1717  USE geometry_mod, ONLY: latitude_deg, longitude_deg
    1818  USE vertical_layers_mod, ONLY: aps, bps, preff
     19#ifdef REPROBUS
     20  USE chem_rep, ONLY: itroprep
     21#endif
    1922
    2023!-------------------------------------------------------------------------------
    … …  
    108111      DO kt=1,klev-1; IF(pplay(i,kt+1)>dyn_tropopause(i)) EXIT; END DO; kp=kt
    109112    END IF
     113#ifdef REPROBUS
     114    itroprep(i)=MAX(kt,kp)
     115#endif
    110116    !--- LAST TROPOSPHERIC LAYER INDEX NEEDED
    111117    IF(PRESENT(itrop)) itrop(i)=MAX(kt,kp)
Note: See TracChangeset for help on using the changeset viewer.