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

Sync latest trunk changes to branch Ocean_skin

Location:
LMDZ6/branches/Ocean_skin
Files:
3 edited
1 copied

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Ocean_skin

  • LMDZ6/branches/Ocean_skin/libf/phylmd/phyetat0_mod.F90

    r4368 r4369  
    44
    55  PRIVATE
    6   PUBLIC :: phyetat0, phyetat0_get, phyetat0_srf
    7 
    8   INTERFACE phyetat0_get
    9     MODULE PROCEDURE phyetat0_get10, phyetat0_get20, phyetat0_get11, phyetat0_get21
    10   END INTERFACE phyetat0_get
    11   INTERFACE phyetat0_srf
    12     MODULE PROCEDURE phyetat0_srf20, phyetat0_srf30, phyetat0_srf21, phyetat0_srf31
    13   END INTERFACE phyetat0_srf
     6  PUBLIC :: phyetat0
    147
    158CONTAINS
    … …  
    2316  USE pbl_surface_mod,  ONLY : pbl_surface_init
    2417  USE surface_data,     ONLY : type_ocean, version_ocean
     18  USE phyetat0_get_mod, ONLY : phyetat0_get, phyetat0_srf
    2519  USE phys_state_var_mod, ONLY : ancien_ok, clwcon, detr_therm, phys_tstep, &
    2620       qsol, fevap, z0m, z0h, agesno, &
    … …  
    611605END SUBROUTINE phyetat0
    612606
    613 !==============================================================================
    614 LOGICAL FUNCTION phyetat0_get10(field, name, descr, default) RESULT(lFound)
    615 ! Read a field. Check whether reading succeded and use default value if not.
    616   IMPLICIT NONE
    617   REAL,             INTENT(INOUT) :: field(:) ! klon
    618   CHARACTER(LEN=*), INTENT(IN)    :: name
    619   CHARACTER(LEN=*), INTENT(IN)    :: descr
    620   REAL,             INTENT(IN)    :: default
    621 !------------------------------------------------------------------------------
    622   REAL :: fld(SIZE(field),1)
    623   lFound = phyetat0_get21(fld, [name], descr, default); field = fld(:,1)
    624 END FUNCTION phyetat0_get10
    625 !==============================================================================
    626 LOGICAL FUNCTION phyetat0_get20(field, name, descr, default) RESULT(lFound)
    627 ! Same as phyetat0_get11, field on multiple levels.
    628   IMPLICIT NONE
    629   REAL,             INTENT(INOUT) :: field(:,:) ! klon, nlev
    630   CHARACTER(LEN=*), INTENT(IN)    :: name
    631   CHARACTER(LEN=*), INTENT(IN)    :: descr
    632   REAL,             INTENT(IN)    :: default
    633 !-----------------------------------------------------------------------------
    634   lFound = phyetat0_get21(field, [name], descr, default)
    635 END FUNCTION phyetat0_get20
    636 !==============================================================================
    637 LOGICAL FUNCTION phyetat0_get11(field, name, descr, default) RESULT(lFound)
    638 ! Same as phyetat0_get11, multiple names.
    639   IMPLICIT NONE
    640   REAL,             INTENT(INOUT) :: field(:) ! klon
    641   CHARACTER(LEN=*), INTENT(IN)    :: name(:)
    642   CHARACTER(LEN=*), INTENT(IN)    :: descr
    643   REAL,             INTENT(IN)    :: default
    644 !-----------------------------------------------------------------------------
    645   REAL :: fld(SIZE(field),1)
    646   lFound = phyetat0_get21(fld, name, descr, default); field = fld(:,1)
    647 END FUNCTION phyetat0_get11
    648 !==============================================================================
    649 LOGICAL FUNCTION phyetat0_get21(field, name, descr, default, tname) RESULT(lFound)
    650 ! Same as phyetat0_get11, field on multiple levels, multiple names.
    651   USE iostart,           ONLY: get_field
    652   USE print_control_mod, ONLY: lunout
    653   IMPLICIT NONE
    654   REAL,             INTENT(INOUT) :: field(:,:) ! klon, nlev
    655   CHARACTER(LEN=*), INTENT(IN)    :: name(:)
    656   CHARACTER(LEN=*), INTENT(IN)    :: descr
    657   REAL,             INTENT(IN)    :: default
    658   CHARACTER(LEN=*), OPTIONAL, INTENT(OUT) :: tname
    659 !-----------------------------------------------------------------------------
    660   CHARACTER(LEN=LEN(name)) :: tnam
    661   INTEGER :: i
    662   DO i = 1, SIZE(name)
    663     CALL get_field(TRIM(name(i)), field, lFound)
    664     IF(lFound) EXIT
    665     WRITE(lunout,*) "phyetat0: Missing field <",TRIM(name(i)),"> "
    666   END DO
    667   IF(.NOT.lFound) THEN
    668     WRITE(lunout,*) "Slightly distorted start ; continuing."
    669     field(:,:) = default
    670     tnam = name(1)
    671   ELSE
    672     tnam = name(i)
    673   END IF
    674   WRITE(lunout,'(2(a,ES14.7))') 'phyetat0: '//TRIM(tnam)//' ('//TRIM(descr)//') min/max=', &
    675     MINval(field),' ',MAXval(field)
    676   IF(PRESENT(tname)) tname = tnam
    677 END FUNCTION phyetat0_get21
    678 !==============================================================================
    679 LOGICAL FUNCTION phyetat0_srf20(field, name, descr, default) RESULT(lFound)
    680 ! Read a field per sub-surface.
    681 ! Check whether reading succeded and use default value if not.
    682   IMPLICIT NONE
    683   REAL,             INTENT(INOUT) :: field(:,:)
    684   CHARACTER(LEN=*), INTENT(IN)    :: name
    685   CHARACTER(LEN=*), INTENT(IN)    :: descr
    686   REAL,             INTENT(IN)    :: default
    687 !-----------------------------------------------------------------------------
    688   REAL :: fld(SIZE(field,1),1,SIZE(field,2))
    689   lFound = phyetat0_srf31(fld, [name], descr, default); field = fld(:,1,:)
    690 END FUNCTION phyetat0_srf20
    691 
    692 !==============================================================================
    693 LOGICAL FUNCTION phyetat0_srf30(field, name, descr, default) RESULT(lFound)
    694 ! Same as phyetat0_sfr11, multiple names tested one after the other.
    695   IMPLICIT NONE
    696   REAL,             INTENT(INOUT) :: field(:,:,:)
    697   CHARACTER(LEN=*), INTENT(IN)    :: name
    698   CHARACTER(LEN=*), INTENT(IN)    :: descr
    699   REAL,             INTENT(IN)    :: default
    700 !-----------------------------------------------------------------------------
    701   lFound = phyetat0_srf31(field, [name], descr, default)
    702 END FUNCTION phyetat0_srf30
    703 
    704 !==============================================================================
    705 LOGICAL FUNCTION phyetat0_srf21(field, name, descr, default) RESULT(lFound)
    706 ! Same as phyetat0_sfr11, field on multiple levels.
    707   IMPLICIT NONE
    708   REAL,             INTENT(INOUT) :: field(:,:)
    709   CHARACTER(LEN=*), INTENT(IN)    :: name(:)
    710   CHARACTER(LEN=*), INTENT(IN)    :: descr
    711   REAL,             INTENT(IN)    :: default
    712 !-----------------------------------------------------------------------------
    713   REAL :: fld(SIZE(field,1),1,SIZE(field,2))
    714   lFound = phyetat0_srf31(fld, name, descr, default); field = fld(:,1,:)
    715 END FUNCTION phyetat0_srf21
    716 
    717 !==============================================================================
    718 LOGICAL FUNCTION phyetat0_srf31(field, name, descr, default) RESULT(lFound)
    719 ! Same as phyetat0_sfr11, field on multiple levels, multiple names tested one after the other.
    720   USE iostart,           ONLY: get_field
    721   USE print_control_mod, ONLY: lunout
    722   USE strings_mod,       ONLY: int2str, maxlen
    723   IMPLICIT NONE
    724   REAL,             INTENT(INOUT) :: field(:,:,:)
    725   CHARACTER(LEN=*), INTENT(IN)    :: name(:)
    726   CHARACTER(LEN=*), INTENT(IN)    :: descr
    727   REAL,             INTENT(IN)    :: default
    728 !-----------------------------------------------------------------------------
    729   INTEGER :: nsrf, i
    730   CHARACTER(LEN=maxlen) :: nam(SIZE(name)), tname, des
    731   IF(SIZE(field,3)>99) CALL abort_physic("phyetat0", "Too much sub-cells", 1)
    732   DO nsrf = 1, SIZE(field,3)
    733     DO i = 1, SIZE(name); nam(i) = TRIM(name(i))//TRIM(int2str(nsrf,2)); END DO
    734     des = TRIM(descr)//" srf:"//int2str(nsrf,2)
    735     lFound = phyetat0_get21(field(:,:,nsrf), nam, TRIM(des), default, tname)
    736   END DO
    737   WRITE(lunout,'(2(a,ES14.7))') 'phyetat0: '//TRIM(tname)//' ('//TRIM(descr)//') min/max=', &
    738     MINval(field),' ',MAXval(field)
    739 END FUNCTION phyetat0_srf31
    740 
    741607END MODULE phyetat0_mod
    742608

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

    r4368 r4369  
    3434    USE FLOTT_GWD_rando_m, only: FLOTT_GWD_rando
    3535    USE fonte_neige_mod, ONLY  : fonte_neige_get_vars
    36     USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg, longitude,latitude, &
    37          boundslon,boundslat, dx, dy, ind_cell_glo
     36    USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
    3837    USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, &
    3938         histwrite, ju2ymds, ymds2ju, getin
    4039    USE ioipsl_getin_p_mod, ONLY : getin_p
    4140    USE indice_sol_mod
    42     USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, types_trac, nqCO2
     41    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, types_trac
    4342    USE readTracFiles_mod, ONLY: addPhase
    4443    USE strings_mod,  ONLY: strIdx
    … …  
    7069    USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz
    7170    USE regr_pr_time_av_m, only: regr_pr_time_av
    72     USE surface_data,     ONLY : type_ocean, ok_veget, landice_opt
    73     USE time_phylmdz_mod, only: annee_ref, current_time, day_ini, day_ref, &
    74           day_step_phy, itau_phy, pdtphys, raz_date, start_time, update_time, ndays
     71    USE surface_data,     ONLY : type_ocean, ok_veget
     72    USE time_phylmdz_mod, only: current_time, itau_phy, pdtphys, raz_date, update_time
    7573    USE tracinca_mod, ONLY: config_inca
    7674    USE tropopause_m,     ONLY: dyn_tropopause
    7775    USE ice_sursat_mod,  ONLY: flight_init, airplane
    7876    USE vampir
    79     USE VERTICAL_LAYERS_MOD, ONLY: aps,bps, ap, bp
    8077    USE write_field_phy
    8178#ifdef CPP_XIOS
    … …  
    10299
    103100
     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
    104106#ifdef REPROBUS
    105     USE CHEM_REP, ONLY : Init_chem_rep_xjour, &
    106          d_q_rep,d_ql_rep,d_qi_rep,ptrop,ttrop, &
    107          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
    108113#endif
    109114
    … …  
    111116#ifdef CPP_RRTM
    112117    USE YOERAD, ONLY : NRADLP
    113     USE YOESW, ONLY : RSUN
     118!    USE YOESW, ONLY : RSUN
    114119#endif
    115120
    … …  
    147152       d_t_ajsb,d_q_ajsb, &
    148153       d_t_ajs,d_q_ajs,d_u_ajs,d_v_ajs, &
    149        d_t_ajs_w,d_q_ajs_w, &
    150        d_t_ajs_x,d_q_ajs_x, &
     154!       d_t_ajs_w,d_q_ajs_w, &
     155!       d_t_ajs_x,d_q_ajs_x, &
    151156       !
    152157       d_t_eva,d_q_eva,d_ql_eva,d_qi_eva, &
    … …  
    161166       d_ts, &
    162167       !
    163        d_t_oli,d_u_oli,d_v_oli, &
     168!       d_t_oli,d_u_oli,d_v_oli, &
    164169       d_t_oro,d_u_oro,d_v_oro, &
    165170       d_t_oro_gw,d_u_oro_gw,d_v_oro_gw, &
    … …  
    492497    REAL dtadd(klon,klev)
    493498
    494 !#ifdef CPP_XIOS
    495 !    TYPE(xios_context), SAVE :: g_ctx
    496 !#endif
    497 
    498499#ifndef CPP_XIOS
    499500    REAL, SAVE :: missing_val=nf90_fill_real
    … …  
    522523    !
    523524    !
    524     INTEGER debug
    525525    INTEGER n
    526526    !ym      INTEGER npoints
    … …  
    579579    ! Upmost level reached by deep convection and related variable (jyg)
    580580    !
    581     INTEGER izero
     581!    INTEGER izero
    582582    INTEGER k_upper_cv
    583583    !------------------------------------------------------------------
    … …  
    749749    REAL beta_prec_fisrt(klon,klev) ! taux de conv de l'eau cond (fisrt)
    750750    ! RomP <<<
    751     REAL          :: calday
    752751
    753752    !IM cf FH pour Tiedtke 080604
    … …  
    846845    REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
    847846    !
    848 #ifdef INCA
    849     REAL zxsnow_dummy(klon)
    850 #endif
    851847    REAL zsav_tsol(klon)
    852848    !
    … …  
    863859    real zqsat(klon,klev)
    864860    !
    865     INTEGER i, k, iq, j, nsrf, ll, l, itr
     861    INTEGER i, k, iq, nsrf, l, itr
    866862    !
    867863    REAL t_coup
    … …  
    11791175
    11801176#ifdef INCA
     1177    REAL :: calday, zxsnow_dummy(klon)
    11811178    ! set de variables utilisees pour l'initialisation des valeurs provenant de INCA
    11821179    REAL, DIMENSION(klon,klev,naero_grp,nbands) :: init_tauinca
    … …  
    12251222#ifdef CPP_XIOS
    12261223! switch to XIOS LMDZ physics context
    1227 !!!!$OMP MASTER
    1228 !!!!    WRITE(*,*)'PHYSICS XIOS Context :', g_ctx
    1229 !!!!    CALL wxios_set_context()
    1230 !!!!$OMP END MASTER
    12311224    IF (.NOT. debut .AND. is_omp_master) THEN
    12321225       CALL wxios_set_context()
    … …  
    13021295       CALL strataer_init
    13031296#endif
    1304 
    1305        !!CALL flight_init
    13061297
    13071298       print*, '================================================='
    … …  
    22212212      ENDIF
    22222213    ENDIF
    2223 ! switch to XIOS LMDZ physics context just in case
    2224 !$OMP MASTER
    2225 !!!!#ifdef CPP_XIOS
    2226 !!!!    WRITE(*,*)'PHYSICS XIOS Context :', g_ctx
    2227 !!!!    CALL xios_set_current_context(g_ctx)
    2228 !!!!#endif
    2229 !$OMP END MASTER
    2230 
    22312214    !
    22322215    !
    … …  
    51895172    ENDDO
    51905173    !
    5191     IF (nqtot > nqo) THEN
    5192        itr = 0
    5193        DO iq = 1, nqtot
    5194           IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    5195           itr = itr+1
    5196           DO  k = 1, klev
    5197              DO  i = 1, klon
    5198                 d_qx(i,k,iq) = ( tr_seri(i,k,itr) - qx(i,k,iq) ) / phys_tstep
    5199              ENDDO
     5174    ! DC: All iterations are cycled if nqtot==nqo, so no nqtot>nqo condition required
     5175    itr = 0
     5176    DO iq = 1, nqtot
     5177       IF(.NOT.tracers(iq)%isInPhysics) CYCLE
     5178       itr = itr+1
     5179       DO  k = 1, klev
     5180          DO  i = 1, klon
     5181             d_qx(i,k,iq) = ( tr_seri(i,k,itr) - qx(i,k,iq) ) / phys_tstep
    52005182          ENDDO
    52015183       ENDDO
    5202     ENDIF
     5184    ENDDO
    52035185    !
    52045186    !IM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano
Note: See TracChangeset for help on using the changeset viewer.