Ignore:
Timestamp:
Dec 6, 2022, 1:01:47 PM (20 months ago)
Author:
lguez
Message:

Sync latest trunk changes to branch Ocean_skin

Location:
LMDZ6/branches/Ocean_skin
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Ocean_skin

  • LMDZ6/branches/Ocean_skin/libf/phylmdiso/physiq_mod.F90

    r4368 r4369  
    3939    USE ioipsl_getin_p_mod, ONLY : getin_p
    4040    USE indice_sol_mod
    41     USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, types_trac, nqCO2
     41    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, types_trac
    4242    USE readTracFiles_mod, ONLY: addPhase
    43     USE strings_mod,  ONLY: strIdx, strStack, int2str
     43    USE strings_mod,  ONLY: strIdx
    4444    USE iophy
    4545    USE limit_read_mod, ONLY : init_limit_read
    … …  
    5656    USE phystokenc_mod, ONLY: offline, phystokenc
    5757    USE phys_cal_mod, only: year_len, mth_len, days_elapsed, jh_1jan, &
    58          year_cur, mth_cur,jD_cur, jH_cur, jD_ref, day_cur, hour
     58         year_cur, mth_cur,jD_cur, jH_cur, jD_ref, day_cur, hour, calend
    5959!!  USE phys_local_var_mod, ONLY : a long list of variables
    6060!!              ==> see below, after "CPP Keys" section
    … …  
    6969    USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz
    7070    USE regr_pr_time_av_m, only: regr_pr_time_av
    71     USE surface_data,     ONLY : type_ocean, ok_veget, landice_opt
    72     USE time_phylmdz_mod, only: annee_ref, current_time, day_ini, day_ref, &
    73           day_step_phy, itau_phy, pdtphys, raz_date, start_time, update_time
     71    USE surface_data,     ONLY : type_ocean, ok_veget
     72    USE time_phylmdz_mod, only: current_time, itau_phy, pdtphys, raz_date, update_time
    7473    USE tracinca_mod, ONLY: config_inca
    7574    USE tropopause_m,     ONLY: dyn_tropopause
    7675    USE ice_sursat_mod,  ONLY: flight_init, airplane
    7776    USE vampir
    78     USE VERTICAL_LAYERS_MOD, ONLY: aps,bps, ap, bp
    7977    USE write_field_phy
     78#ifdef CPP_XIOS
     79    USE wxios, ONLY: g_ctx, wxios_set_context
     80#endif
    8081    USE lscp_mod, ONLY : lscp
     82    USE wake_ini_mod, ONLY : wake_ini
    8183    USE thermcell_ini_mod, ONLY : thermcell_ini
    8284
    … …  
    9799
    98100
     101#ifdef INCA
     102    USE geometry_mod,      ONLY: longitude, latitude, boundslon, boundslat, ind_cell_glo
     103    USE time_phylmdz_mod,  ONLY: ndays
     104    USE infotrac_phy,      ONLY: nqCO2
     105#endif
    99106#ifdef REPROBUS
    100     USE CHEM_REP, ONLY : Init_chem_rep_xjour, &
    101          d_q_rep,d_ql_rep,d_qi_rep,ptrop,ttrop, &
    102          ztrop, gravit,itroprep, Z1,Z2,fac,B
     107    USE chem_rep, ONLY: Init_chem_rep_xjour, d_q_rep, d_ql_rep, d_qi_rep, &
     108                        ptrop, ttrop, ztrop, gravit, itroprep, Z1, Z2, fac, B
     109#endif
     110#if defined INCA || defined REPROBUS
     111    USE time_phylmdz_mod,    ONLY: annee_ref, day_ini, day_ref, start_time
     112    USE vertical_layers_mod, ONLY: aps, bps, ap, bp
    103113#endif
    104114
    … …  
    106116#ifdef CPP_RRTM
    107117    USE YOERAD, ONLY : NRADLP
    108     USE YOESW, ONLY : RSUN
     118!    USE YOESW, ONLY : RSUN
    109119#endif
    110120
    … …  
    116126
    117127#ifdef CPP_XIOS
    118     USE xios, ONLY: xios_update_calendar, xios_context_finalize, &
    119             xios_get_field_attr, xios_field_is_active
     128    USE xios, ONLY: xios_update_calendar, xios_context_finalize
     129    USE xios, ONLY: xios_get_field_attr, xios_field_is_active, xios_context
     130    USE xios, ONLY: xios_set_current_context
    120131    USE wxios, ONLY: missing_val, missing_val_omp
    121132#endif
    … …  
    180191       d_t_ajsb,d_q_ajsb, &
    181192       d_t_ajs,d_q_ajs,d_u_ajs,d_v_ajs, &
    182        d_t_ajs_w,d_q_ajs_w, &
    183        d_t_ajs_x,d_q_ajs_x, &
     193!       d_t_ajs_w,d_q_ajs_w, &
     194!       d_t_ajs_x,d_q_ajs_x, &
    184195       !
    185196       d_t_eva,d_q_eva,d_ql_eva,d_qi_eva, &
    … …  
    194205       d_ts, &
    195206       !
    196        d_t_oli,d_u_oli,d_v_oli, &
     207!       d_t_oli,d_u_oli,d_v_oli, &
    197208       d_t_oro,d_u_oro,d_v_oro, &
    198209       d_t_oro_gw,d_u_oro_gw,d_v_oro_gw, &
    … …  
    366377#endif
    367378       !
    368 
    369379
    370380    IMPLICIT NONE
    … …  
    579589    !
    580590    !
    581     INTEGER debug
    582591    INTEGER n
    583592    !ym      INTEGER npoints
    … …  
    636645    ! Upmost level reached by deep convection and related variable (jyg)
    637646    !
    638     INTEGER izero
     647!    INTEGER izero
    639648    INTEGER k_upper_cv
    640649    !------------------------------------------------------------------
    … …  
    814823    REAL beta_prec_fisrt(klon,klev) ! taux de conv de l'eau cond (fisrt)
    815824    ! RomP <<<
    816     REAL          :: calday
    817825
    818826    !IM cf FH pour Tiedtke 080604
    … …  
    934942    real zqsat(klon,klev)
    935943    !
    936     INTEGER i, k, iq, j, nsrf, ll, l, itr
     944    INTEGER i, k, iq, nsrf, l, itr
    937945#ifdef ISO
    938946    real zxt_apres(ntraciso,klon)
    … …  
    10561064
    10571065    REAL picefra(klon,klev)
     1066    REAL zrel_mount(klon)
    10581067    !IM cf. AM 081204 END
    10591068    !
    … …  
    12651274
    12661275#ifdef INCA
     1276    REAL :: calday, zxsnow_dummy(klon)
    12671277    ! set de variables utilisees pour l'initialisation des valeurs provenant de INCA
    12681278    REAL, DIMENSION(klon,klev,naero_grp,nbands) :: init_tauinca
    … …  
    13131323    phys_tstep=NINT(pdtphys)
    13141324#ifdef CPP_XIOS
    1315     IF (.NOT. debut .AND. is_omp_master) CALL xios_update_calendar(itap+1)
     1325! switch to XIOS LMDZ physics context
     1326    IF (.NOT. debut .AND. is_omp_master) THEN
     1327       CALL wxios_set_context()
     1328       CALL xios_update_calendar(itap+1)
     1329    ENDIF
    13161330#endif
    13171331
    … …  
    14031417          WRITE (lunout, *) ' ok_ice_sursat=y requires 4 H2O tracers ', &
    14041418               '(H2O_g, H2O_l, H2O_s, H2O_r) but nqo=', nqo, '. Might as well stop here.'
     1419          abort_message='see above'
     1420          CALL abort_physic(modname,abort_message,1)
     1421       ENDIF
     1422
     1423       IF (ok_plane_h2o.AND..NOT.ok_ice_sursat) THEN
     1424          WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_sursat=y '
     1425          abort_message='see above'
     1426          CALL abort_physic(modname,abort_message,1)
     1427       ENDIF
     1428
     1429       IF (ok_plane_contrail.AND..NOT.ok_ice_sursat) THEN
     1430          WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_sursat=y '
    14051431          abort_message='see above'
    14061432          CALL abort_physic(modname,abort_message,1)
    … …  
    18471873!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    18481874       ! Nouvelle initialisation pour le rayonnement RRTM
    1849        !
    18501875!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    18511876
    18521877       CALL iniradia(klon,klev,paprs(1,1:klev+1))
    18531878
    1854 
    18551879!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1880       CALL wake_ini(rg,rd,rv,prt_level)
    18561881       CALL thermcell_ini(iflag_thermals,prt_level,tau_thermals,lunout, &
    18571882   &    RG,RD,RCPD,RKAPPA,RLVTT,RETV)
     1883
     1884!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1885
    18581886       !
    18591887!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    21512179       !c         ENDDO
    21522180       !
    2153        IF (ANY(types_trac == 'inca') .OR. ANY(types_trac == 'inco')) THEN  ! ModThL
     2181       IF (ANY(types_trac == 'inca') .OR. ANY(types_trac == 'inco')) THEN ! ModThL
    21542182#ifdef INCA
    21552183          CALL VTe(VTphysiq)
    … …  
    21582186          WRITE(lunout,*) 'initial time chemini', days_elapsed, calday
    21592187
    2160           CALL chemini(  &
    2161                rg, &
    2162                ra, &
    2163                cell_area, &
    2164                latitude_deg, &
    2165                longitude_deg, &
    2166                presnivs, &
    2167                calday, &
    2168                klon, &
    2169                nqtot, &
    2170                nqo+nqCO2, &
    2171                pdtphys, &
    2172                annee_ref, &
    2173                year_cur, &
    2174                day_ref,  &
    2175                day_ini, &
    2176                start_time, &
    2177                itau_phy, &
    2178                date0, &
    2179                io_lon, &
    2180                io_lat, &
    2181                chemistry_couple, &
    2182                init_source, &
    2183                init_tauinca, &
    2184                init_pizinca, &
    2185                init_cginca, &
    2186                init_ccminca)
     2188          call init_const_lmdz( &
     2189          ndays, nbsrf, is_oce,is_sic, is_ter,is_lic, calend, &
     2190          config_inca)
     2191
     2192          CALL init_inca_geometry( &
     2193               longitude, latitude, &
     2194               boundslon, boundslat, &
     2195               cell_area, ind_cell_glo)
     2196
     2197          if (grid_type==unstructured) THEN
     2198             CALL chemini(  pplay, &
     2199                  nbp_lon, nbp_lat, &
     2200                  latitude_deg, &
     2201                  longitude_deg, &
     2202                  presnivs, &
     2203                  calday, &
     2204                  klon, &
     2205                  nqtot, &
     2206                  nqo+nqCO2, &
     2207                  pdtphys, &
     2208                  annee_ref, &
     2209                  year_cur, &
     2210                  day_ref,  &
     2211                  day_ini, &
     2212                  start_time, &
     2213                  itau_phy, &
     2214                  date0, &
     2215                  chemistry_couple, &
     2216                  init_source, &
     2217                  init_tauinca, &
     2218                  init_pizinca, &
     2219                  init_cginca, &
     2220                  init_ccminca)
     2221          ELSE
     2222             CALL chemini(  pplay, &
     2223                  nbp_lon, nbp_lat, &
     2224                  latitude_deg, &
     2225                  longitude_deg, &
     2226                  presnivs, &
     2227                  calday, &
     2228                  klon, &
     2229                  nqtot, &
     2230                  nqo+nqCO2, &
     2231                  pdtphys, &
     2232                  annee_ref, &
     2233                  year_cur, &
     2234                  day_ref,  &
     2235                  day_ini, &
     2236                  start_time, &
     2237                  itau_phy, &
     2238                  date0, &
     2239                  chemistry_couple, &
     2240                  init_source, &
     2241                  init_tauinca, &
     2242                  init_pizinca, &
     2243                  init_cginca, &
     2244                  init_ccminca, &
     2245                  io_lon, &
     2246                  io_lat)
     2247          ENDIF
    21872248
    21882249
    … …  
    22862347
    22872348
     2349
    22882350    ENDIF
    22892351    !
    … …  
    23902452          ql_seri(i,k) = qx(i,k,iliq)
    23912453          !CR: ATTENTION, on rajoute la variable glace
    2392           IF (nqo.eq.2) THEN
     2454          IF (nqo.EQ.2) THEN             !--vapour and liquid only
    23932455             qs_seri(i,k) = 0.
    2394           ELSE IF (nqo.eq.3) THEN
     2456             rneb_seri(i,k) = 0.
     2457          ELSE IF (nqo.EQ.3) THEN        !--vapour, liquid and ice
    23952458             qs_seri(i,k) = qx(i,k,isol)
    2396           ELSE IF (nqo.eq.4) THEN
     2459             rneb_seri(i,k) = 0.
     2460          ELSE IF (nqo.EQ.4) THEN        !--vapour, liquid, ice and rneb
    23972461             qs_seri(i,k) = qx(i,k,isol)
    23982462             rneb_seri(i,k) = qx(i,k,irneb)
    … …  
    26582722       ! !! RomP >>>   td dyn traceur
    26592723       IF (nqtot > nqo) d_tr_dyn(:,:,:)= 0.0
     2724       ! !! RomP <<<
    26602725       d_rneb_dyn(:,:)=0.0
    2661        ! !! RomP <<<
    26622726       ancien_ok = .TRUE.
    26632727    ENDIF
    … …  
    46084672    IF (ok_new_lscp) THEN
    46094673
     4674    !--mise à jour de flight_m et flight_h2o dans leur module
     4675    IF (ok_plane_h2o .OR. ok_plane_contrail) THEN
     4676      CALL airplane(debut,pphis,pplay,paprs,t_seri)
     4677    ENDIF
     4678
    46104679    CALL lscp(phys_tstep,missing_val,paprs,pplay, &
    46114680         t_seri, q_seri,ptconv,ratqs, &
    … …  
    46194688
    46204689    ELSE
     4690
    46214691    CALL fisrtilp(phys_tstep,paprs,pplay, &
    46224692         t_seri, q_seri,ptconv,ratqs, &
    … …  
    46904760       ENDDO
    46914761    ENDDO
    4692     IF (nqo==3) THEN
     4762    IF (nqo >= 3) THEN
    46934763    DO k = 1, klev
    46944764       DO i = 1, klon
    … …  
    57325802       DO i=1,klon
    57335803          itest(i)=0
    5734           !        IF ((zstd(i).gt.10.0)) THEN
    5735           IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
     5804          zrel_mount(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i)))
     5805          !zrel_mount: relative mountain height wrt relief explained by mean slope
     5806          ! -> condition on zrel_mount can deactivate the drag on tilted planar terrains
     5807          !    such as ice sheets (work by V. Wiener)
     5808          IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0).AND.(zrel_mount(i).GE.zrel_mount_t)) THEN
    57365809             itest(i)=1
    57375810             igwd=igwd+1
    … …  
    57865859       DO i=1,klon
    57875860          itest(i)=0
    5788           IF ((zpic(i)-zmea(i)).GT.100.) THEN
     5861          !zrel_mount: relative mountain height wrt relief explained by mean slope
     5862          ! -> condition on zrel_mount can deactivate the lifting on tilted planar terrains
     5863          !    such as ice sheets (work by V. Wiener)
     5864          zrel_mount(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i)))
     5865          IF (((zpic(i)-zmea(i)).GT.100.).AND.(zrel_mount(i).GE.zrel_mount_t)) THEN
    57895866             itest(i)=1
    57905867             igwd=igwd+1
    … …  
    62736350    ELSE
    62746351       sh_in(:,:) = qx(:,:,ivap)
    6275        IF (nqo .EQ. 3) THEN
     6352       IF (nqo >= 3) THEN
    62766353          ch_in(:,:) = qx(:,:,iliq) + qx(:,:,isol)
    62776354       ELSE
    … …  
    63606437    ! Calculer le transport de l'eau et de l'energie (diagnostique)
    63616438    !
    6362     CALL transp (paprs, zxtsol, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, zphi, &
     6439    CALL transp (paprs,zxtsol, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, zphi, &
    63636440                 ue, ve, uq, vq, uwat, vwat)
    63646441    !
    … …  
    63666443    IF(1.EQ.0) THEN
    63676444       !
    6368        CALL transp_lay (paprs,zxtsol, &
    6369             t_seri, q_seri, u_seri, v_seri, zphi, &
     6445       CALL transp_lay (paprs,zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &
    63706446            ve_lay, vq_lay, ue_lay, uq_lay)
    63716447       !
    … …  
    64456521            pphis, &
    64466522            zx_rh, &
    6447             aps, bps, ap, bp)
     6523            aps, bps, ap, bp, lafin)
    64486524
    64496525       CALL VTe(VTinca)
    … …  
    64526528    ENDIF
    64536529
     6530    IF (ANY(types_trac == 'repr')) THEN
     6531#ifdef REPROBUS
     6532        CALL coord_hyb_rep(paprs, pplay, aps, bps, ap, bp, cell_area)
     6533#endif
     6534    ENDIF
    64546535
    64556536    !
    … …  
    64756556          d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / phys_tstep
    64766557          !CR: on ajoute le contenu en glace
    6477           IF (nqo.ge.3) THEN
     6558          IF (nqo >= 3) THEN
    64786559             d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / phys_tstep
    64796560          ENDIF
    64806561          !--ice_sursat: nqo=4, on ajoute rneb
    6481           IF (nqo.eq.4) THEN
     6562          IF (nqo == 4) THEN
    64826563             d_qx(i,k,irneb) = ( rneb_seri(i,k) - qx(i,k,irneb) ) / phys_tstep
    64836564          ENDIF
    … …  
    65016582      enddo ! DO k = 1, klev
    65026583    enddo !do ixt=1,ntraciso
    6503 !#ifdef ISOVERIF
    6504 !        write(*,*) 'physiq 6120: d_qx(1,1,:)=',d_qx(1,1,:)
    6505 !        write(*,*) 'qx(1,1,:)=',qx(1,1,:)
    6506 !        write(*,*) 'xt_seri(:,1,1)=',xt_seri(:,1,1)
    6507 !#endif
    6508 #endif
    6509 ! #ifdef ISO
     6584#endif
    65106585    ! DC: All iterations are cycled if nqtot==nqo, so no nqtot>nqo condition required
    65116586    itr = 0
    … …  
    65676642    ql_ancien(:,:) = ql_seri(:,:)
    65686643    qs_ancien(:,:) = qs_seri(:,:)
     6644    rneb_ancien(:,:) = rneb_seri(:,:)
    65696645#ifdef ISO
    65706646    xt_ancien(:,:,:)=xt_seri(:,:,:)
    … …  
    68266902#ifdef CPP_XIOS
    68276903       IF (is_omp_master) CALL xios_context_finalize
     6904
     6905#ifdef INCA
     6906       if (ANY(types_trac == 'inca' )) then
     6907          IF (is_omp_master .and. grid_type==unstructured) THEN
     6908             CALL finalize_inca
     6909          ENDIF
     6910       endif
     6911#endif
     6912
    68286913#endif
    68296914       WRITE(lunout,*) ' physiq fin, nombre de steps ou cvpas = 1 : ', Ncvpaseq1
Note: See TracChangeset for help on using the changeset viewer.