Ignore:
Timestamp:
Nov 21, 2019, 4:43:45 PM (5 years ago)
Author:
lguez
Message:

Merge revisions 3427:3600 of trunk into branch Ocean_skin

Location:
LMDZ6/branches/Ocean_skin
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • LMDZ6/branches/Ocean_skin

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

    • Property svn:keywords set to Id
    r3401 r3605  
     1!
     2! $Id$
     3!
    14MODULE phyaqua_mod
    25  ! Routines complementaires pour la physique planetaire.
     
    58CONTAINS
    69
    7   SUBROUTINE iniaqua(nlon, iflag_phys)
     10  SUBROUTINE iniaqua(nlon,year_len,iflag_phys)
    811
    912    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     
    2932    USE indice_sol_mod
    3033    USE nrtype, ONLY: pi
    31     USE ioipsl
     34!    USE ioipsl
     35    USE mod_phys_lmdz_para, ONLY: is_master
     36    USE mod_phys_lmdz_transfert_para, ONLY: bcast
     37    USE mod_grid_phy_lmdz
     38    USE ioipsl_getin_p_mod, ONLY : getin_p
     39    USE phys_cal_mod , ONLY: calend, year_len_phy => year_len
    3240    IMPLICIT NONE
    3341
     
    3644    include "dimsoil.h"
    3745
    38     INTEGER, INTENT (IN) :: nlon, iflag_phys
     46    INTEGER, INTENT (IN) :: nlon, year_len, iflag_phys
    3947    ! IM ajout latfi, lonfi
    4048!    REAL, INTENT (IN) :: lonfi(nlon), latfi(nlon)
     
    5765    INTEGER it, unit, i, k, itap
    5866
    59     REAL airefi, zcufi, zcvfi
    60 
    6167    REAL rugos, albedo
    6268    REAL tsurf
     
    6470    REAL qsol_f
    6571    REAL rugsrel(nlon)
    66     ! real zmea(nlon),zstd(nlon),zsig(nlon)
    67     ! real zgam(nlon),zthe(nlon),zpic(nlon),zval(nlon)
    68     ! real rlon(nlon),rlat(nlon)
    6972    LOGICAL alb_ocean
    70     ! integer demih_pas
    7173
    7274    CHARACTER *80 ans, file_forctl, file_fordat, file_start
     
    7476    CHARACTER *2 cnbl
    7577
    76     REAL phy_nat(nlon, 360)
    77     REAL phy_alb(nlon, 360)
    78     REAL phy_sst(nlon, 360)
    79     REAL phy_bil(nlon, 360)
    80     REAL phy_rug(nlon, 360)
    81     REAL phy_ice(nlon, 360)
    82     REAL phy_fter(nlon, 360)
    83     REAL phy_foce(nlon, 360)
    84     REAL phy_fsic(nlon, 360)
    85     REAL phy_flic(nlon, 360)
     78    REAL phy_nat(nlon, year_len)
     79    REAL phy_alb(nlon, year_len)
     80    REAL phy_sst(nlon, year_len)
     81    REAL phy_bil(nlon, year_len)
     82    REAL phy_rug(nlon, year_len)
     83    REAL phy_ice(nlon, year_len)
     84    REAL phy_fter(nlon, year_len)
     85    REAL phy_foce(nlon, year_len)
     86    REAL phy_fsic(nlon, year_len)
     87    REAL phy_flic(nlon, year_len)
    8688
    8789    INTEGER, SAVE :: read_climoz = 0 ! read ozone climatology
    88 
    89     ! intermediate variables to use getin (need to be "save" to be shared by
    90     ! all threads)
    91     INTEGER, SAVE :: nbapp_rad_omp
    92     REAL, SAVE :: co2_ppm_omp, solaire_omp
    93     LOGICAL, SAVE :: alb_ocean_omp
    94     REAL, SAVE :: rugos_omp
     90!$OMP THREADPRIVATE(read_climoz)
     91
    9592    ! -------------------------------------------------------------------------
    9693    ! declaration pour l'appel a phyredem
     
    117114    INTEGER l, ierr, aslun
    118115
    119 !    REAL longitude, latitude
    120116    REAL paire
    121117
    122 !    DATA latitude, longitude/48., 0./
     118    ! Local
     119    CHARACTER (LEN=20) :: modname='phyaqua'
     120    CHARACTER (LEN=80) :: abort_message
     121
    123122
    124123    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     
    130129    ! -------------------------------
    131130
     131    !IF (calend .EQ. "earth_360d") Then
     132      year_len_phy = year_len
     133    !END IF
     134   
     135    if (year_len.ne.360) then
     136      write (*,*) year_len
     137      write (*,*) 'iniaqua: 360 day calendar is required !'
     138      stop
     139    endif
    132140
    133141    type_aqua = iflag_phys/100
     
    137145    IF (klon/=nlon) THEN
    138146      WRITE (*, *) 'iniaqua: klon=', klon, ' nlon=', nlon
    139       STOP 'probleme de dimensions dans iniaqua'
     147      abort_message= 'probleme de dimensions dans iniaqua'
     148      CALL abort_physic(modname,abort_message,1)
    140149    END IF
    141150    CALL phys_state_var_init(read_climoz)
     
    148157    time = 0.
    149158
    150     ! IM ajout latfi, lonfi
    151 !    rlatd = latfi
    152 !    rlond = lonfi
    153 !    rlat = rlatd*180./pi
    154 !    rlon = rlond*180./pi
    155 
    156159    ! -----------------------------------------------------------------------
    157160    ! initialisations de la physique
     
    160163    day_ini = day_ref
    161164    day_end = day_ini + ndays
    162 !    airefi = 1.
    163 !    zcufi = 1.
    164 !    zcvfi = 1.
    165     !$OMP MASTER
    166     nbapp_rad_omp = 24
    167     CALL getin('nbapp_rad', nbapp_rad_omp)
    168     !$OMP END MASTER
    169     !$OMP BARRIER
    170     nbapp_rad = nbapp_rad_omp
     165
     166    nbapp_rad = 24
     167    CALL getin_p('nbapp_rad', nbapp_rad)
    171168
    172169    ! ---------------------------------------------------------------------
     
    175172    ! Initialisations des constantes
    176173    ! Ajouter les manquants dans planete.def... (albedo etc)
    177     !$OMP MASTER
    178     co2_ppm_omp = 348.
    179     CALL getin('co2_ppm', co2_ppm_omp)
    180     solaire_omp = 1365.
    181     CALL getin('solaire', solaire_omp)
     174    co2_ppm = 348.
     175    CALL getin_p('co2_ppm', co2_ppm)
     176
     177    solaire = 1365.
     178    CALL getin_p('solaire', solaire)
     179 
    182180    ! CALL getin('albedo',albedo) ! albedo is set below, depending on
    183181    ! type_aqua
    184     alb_ocean_omp = .TRUE.
    185     CALL getin('alb_ocean', alb_ocean_omp)
    186     !$OMP END MASTER
    187     !$OMP BARRIER
    188     co2_ppm = co2_ppm_omp
     182    alb_ocean = .TRUE.
     183    CALL getin_p('alb_ocean', alb_ocean)
     184
    189185    WRITE (*, *) 'iniaqua: co2_ppm=', co2_ppm
    190     solaire = solaire_omp
    191186    WRITE (*, *) 'iniaqua: solaire=', solaire
    192     alb_ocean = alb_ocean_omp
    193187    WRITE (*, *) 'iniaqua: alb_ocean=', alb_ocean
    194188
     
    226220    END IF
    227221
    228     !$OMP MASTER
    229     rugos_omp = rugos
    230     CALL getin('rugos', rugos_omp)
    231     !$OMP END MASTER
    232     !$OMP BARRIER
    233     rugos = rugos_omp
     222    CALL getin_p('rugos', rugos)
     223
    234224    WRITE (*, *) 'iniaqua: rugos=', rugos
    235225    zmasq(:) = pctsrf(:, is_ter)
     
    246236    ! endif !alb_ocean
    247237
    248     DO i = 1, 360
     238    DO i = 1, year_len
    249239      ! IM Terraplanete   phy_sst(:,i) = 260.+50.*cos(rlatd(:))**2
    250240      ! IM ajout calcul profil sst selon le cas considere (cf. FBr)
     
    262252    CALL profil_sst(nlon, latitude, type_profil, phy_sst)
    263253
    264     CALL writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, phy_ice, &
    265       phy_fter, phy_foce, phy_flic, phy_fsic)
    266 
     254    IF (grid_type==unstructured) THEN
     255      CALL writelim_unstruct(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, phy_ice, &
     256                             phy_fter, phy_foce, phy_flic, phy_fsic)
     257    ELSE
     258     
     259       CALL writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, phy_ice, &
     260                     phy_fter, phy_foce, phy_flic, phy_fsic)
     261    ENDIF
    267262
    268263    ! ---------------------------------------------------------------------
     
    339334    PRINT *, 'iniaqua: before phyredem'
    340335
    341     pbl_tke(:,:,:)=1.e-8
     336    pbl_tke(:,:,:) = 1.e-8
    342337    falb1 = albedo
    343338    falb2 = albedo
     
    349344    wake_deltaq = 0.
    350345    wake_s = 0.
    351     wake_dens = 0. 
     346    wake_dens = 0.
    352347    wake_cstar = 0.
    353348    wake_pe = 0.
     
    360355    alp_bl =0.
    361356    treedrg(:,:,:)=0.
     357
     358    u10m = 0.
     359    v10m = 0.
     360
     361    ql_ancien   = 0.
     362    qs_ancien   = 0.
     363    u_ancien    = 0.
     364    v_ancien    = 0.
     365    prw_ancien  = 0.
     366    prlw_ancien = 0.
     367    prsw_ancien = 0. 
     368
     369    ale_wake    = 0.
     370    ale_bl_stat = 0. 
     371
     372
     373!ym error : the sub surface dimension is the third not second : forgotten for iniaqua
     374!    falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
     375!    falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
     376    falb_dir(:,:,is_ter)=0.08; falb_dir(:,:,is_lic)=0.6
     377    falb_dir(:,:,is_oce)=0.5;  falb_dir(:,:,is_sic)=0.6
     378
     379!ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ?
     380!ym probably the uninitialized value was 0 for standard (regular grid) case
     381    falb_dif(:,:,:)=0
    362382
    363383
     
    488508  ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    489509
    490   SUBROUTINE writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, &
     510  SUBROUTINE writelim_unstruct(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, &
    491511      phy_ice, phy_fter, phy_foce, phy_flic, phy_fsic)
    492512
    493     USE mod_phys_lmdz_para, ONLY: is_mpi_root, is_omp_root
    494     USE mod_grid_phy_lmdz, ONLY: klon_glo
    495     USE mod_phys_lmdz_transfert_para, ONLY: gather
     513    USE mod_phys_lmdz_para, ONLY: is_omp_master, klon_mpi
     514    USE mod_phys_lmdz_transfert_para, ONLY: gather_omp
     515#ifdef CPP_XIOS
     516    USE xios
     517#endif
    496518    IMPLICIT NONE
     519
    497520    include "netcdf.inc"
    498521
     
    509532    REAL, INTENT (IN) :: phy_fsic(klon, 360)
    510533
    511     REAL :: phy_glo(klon_glo, 360) ! temporary variable, to store phy_***(:)
     534    REAL :: phy_mpi(klon_mpi, 360) ! temporary variable, to store phy_***(:)
     535      ! on the whole physics grid
     536 
     537#ifdef CPP_XIOS
     538    PRINT *, 'writelim: Ecriture du fichier limit'
     539
     540    CALL gather_omp(phy_foce, phy_mpi)
     541    IF (is_omp_master) CALL xios_send_field('foce_limout',phy_mpi)
     542
     543    CALL gather_omp(phy_fsic, phy_mpi)
     544    IF (is_omp_master) CALL xios_send_field('fsic_limout',phy_mpi)
     545     
     546    CALL gather_omp(phy_fter, phy_mpi)
     547    IF (is_omp_master) CALL xios_send_field('fter_limout',phy_mpi)
     548     
     549    CALL gather_omp(phy_flic, phy_mpi)
     550    IF (is_omp_master) CALL xios_send_field('flic_limout',phy_mpi)
     551
     552    CALL gather_omp(phy_sst, phy_mpi)
     553    IF (is_omp_master) CALL xios_send_field('sst_limout',phy_mpi)
     554
     555    CALL gather_omp(phy_bil, phy_mpi)
     556    IF (is_omp_master) CALL xios_send_field('bils_limout',phy_mpi)
     557
     558    CALL gather_omp(phy_alb, phy_mpi)
     559    IF (is_omp_master) CALL xios_send_field('alb_limout',phy_mpi)
     560
     561    CALL gather_omp(phy_rug, phy_mpi)
     562    IF (is_omp_master) CALL xios_send_field('rug_limout',phy_mpi)
     563#endif
     564  END SUBROUTINE writelim_unstruct
     565
     566
     567
     568  SUBROUTINE writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, &
     569      phy_ice, phy_fter, phy_foce, phy_flic, phy_fsic)
     570
     571    USE mod_phys_lmdz_para, ONLY: is_master
     572    USE mod_grid_phy_lmdz, ONLY: klon_glo
     573    USE mod_phys_lmdz_transfert_para, ONLY: gather
     574    USE phys_cal_mod, ONLY: year_len
     575    IMPLICIT NONE
     576    include "netcdf.inc"
     577
     578    INTEGER, INTENT (IN) :: klon
     579    REAL, INTENT (IN) :: phy_nat(klon, year_len)
     580    REAL, INTENT (IN) :: phy_alb(klon, year_len)
     581    REAL, INTENT (IN) :: phy_sst(klon, year_len)
     582    REAL, INTENT (IN) :: phy_bil(klon, year_len)
     583    REAL, INTENT (IN) :: phy_rug(klon, year_len)
     584    REAL, INTENT (IN) :: phy_ice(klon, year_len)
     585    REAL, INTENT (IN) :: phy_fter(klon, year_len)
     586    REAL, INTENT (IN) :: phy_foce(klon, year_len)
     587    REAL, INTENT (IN) :: phy_flic(klon, year_len)
     588    REAL, INTENT (IN) :: phy_fsic(klon, year_len)
     589
     590    REAL :: phy_glo(klon_glo, year_len) ! temporary variable, to store phy_***(:)
    512591      ! on the whole physics grid
    513592    INTEGER :: k
     
    522601    INTEGER id_fter, id_foce, id_fsic, id_flic
    523602
    524     IF (is_mpi_root .AND. is_omp_root) THEN
     603    IF (is_master) THEN
    525604
    526605      PRINT *, 'writelim: Ecriture du fichier limit'
     
    615694
    616695      ! write the 'times'
    617       DO k = 1, 360
     696      DO k = 1, year_len
    618697#ifdef NC_DOUBLE
    619698        ierr = nf_put_var1_double(nid, id_tim, k, dble(k))
     
    627706      END DO
    628707
    629     END IF ! of if (is_mpi_root.and.is_omp_root)
     708    END IF ! of if (is_master)
    630709
    631710    ! write the fields, after having collected them on master
    632711
    633712    CALL gather(phy_nat, phy_glo)
    634     IF (is_mpi_root .AND. is_omp_root) THEN
     713    IF (is_master) THEN
    635714#ifdef NC_DOUBLE
    636715      ierr = nf_put_var_double(nid, id_nat, phy_glo)
     
    645724
    646725    CALL gather(phy_sst, phy_glo)
    647     IF (is_mpi_root .AND. is_omp_root) THEN
     726    IF (is_master) THEN
    648727#ifdef NC_DOUBLE
    649728      ierr = nf_put_var_double(nid, id_sst, phy_glo)
     
    658737
    659738    CALL gather(phy_bil, phy_glo)
    660     IF (is_mpi_root .AND. is_omp_root) THEN
     739    IF (is_master) THEN
    661740#ifdef NC_DOUBLE
    662741      ierr = nf_put_var_double(nid, id_bils, phy_glo)
     
    671750
    672751    CALL gather(phy_alb, phy_glo)
    673     IF (is_mpi_root .AND. is_omp_root) THEN
     752    IF (is_master) THEN
    674753#ifdef NC_DOUBLE
    675754      ierr = nf_put_var_double(nid, id_alb, phy_glo)
     
    684763
    685764    CALL gather(phy_rug, phy_glo)
    686     IF (is_mpi_root .AND. is_omp_root) THEN
     765    IF (is_master) THEN
    687766#ifdef NC_DOUBLE
    688767      ierr = nf_put_var_double(nid, id_rug, phy_glo)
     
    697776
    698777    CALL gather(phy_fter, phy_glo)
    699     IF (is_mpi_root .AND. is_omp_root) THEN
     778    IF (is_master) THEN
    700779#ifdef NC_DOUBLE
    701780      ierr = nf_put_var_double(nid, id_fter, phy_glo)
     
    710789
    711790    CALL gather(phy_foce, phy_glo)
    712     IF (is_mpi_root .AND. is_omp_root) THEN
     791    IF (is_master) THEN
    713792#ifdef NC_DOUBLE
    714793      ierr = nf_put_var_double(nid, id_foce, phy_glo)
     
    723802
    724803    CALL gather(phy_fsic, phy_glo)
    725     IF (is_mpi_root .AND. is_omp_root) THEN
     804    IF (is_master) THEN
    726805#ifdef NC_DOUBLE
    727806      ierr = nf_put_var_double(nid, id_fsic, phy_glo)
     
    736815
    737816    CALL gather(phy_flic, phy_glo)
    738     IF (is_mpi_root .AND. is_omp_root) THEN
     817    IF (is_master) THEN
    739818#ifdef NC_DOUBLE
    740819      ierr = nf_put_var_double(nid, id_flic, phy_glo)
     
    749828
    750829    ! close file:
    751     IF (is_mpi_root .AND. is_omp_root) THEN
     830    IF (is_master) THEN
    752831      ierr = nf_close(nid)
    753832    END IF
     
    759838  SUBROUTINE profil_sst(nlon, rlatd, type_profil, phy_sst)
    760839    USE dimphy
     840    USE phys_cal_mod , ONLY: year_len
    761841    IMPLICIT NONE
    762842
    763843    INTEGER nlon, type_profil, i, k, j
    764     REAL :: rlatd(nlon), phy_sst(nlon, 360)
     844    REAL :: rlatd(nlon), phy_sst(nlon, year_len)
    765845    INTEGER imn, imx, amn, amx, kmn, kmx
    766846    INTEGER p, pplus, nlat_max
    767847    PARAMETER (nlat_max=72)
    768848    REAL x_anom_sst(nlat_max)
    769 
    770     IF (klon/=nlon) STOP 'probleme de dimensions dans iniaqua'
     849    CHARACTER (LEN=20) :: modname='profil_sst'
     850    CHARACTER (LEN=80) :: abort_message
     851
     852    IF (klon/=nlon) THEN
     853       abort_message='probleme de dimensions dans profil_sst'
     854       CALL abort_physic(modname,abort_message,1)
     855    ENDIF
    771856    WRITE (*, *) ' profil_sst: type_profil=', type_profil
    772     DO i = 1, 360
     857    DO i = 1, year_len
    773858      ! phy_sst(:,i) = 260.+50.*cos(rlatd(:))**2
    774859
     
    9631048    imx = 1
    9641049    kmx = 1
    965     DO k = 1, 360
     1050    DO k = 1, year_len
    9661051      DO i = 2, nlon
    9671052        IF (phy_sst(i,k)<amn) THEN
Note: See TracChangeset for help on using the changeset viewer.