Changeset 3312


Ignore:
Timestamp:
Apr 11, 2018, 10:27:28 AM (6 years ago)
Author:
Laurent Fairhead
Message:

Continuing phasing of DYNAMICO and LMDZ physics

Location:
LMDZ6/branches/DYNAMICO-conv/libf/phylmd
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/DYNAMICO-conv/libf/phylmd/iophy.F90

    r3077 r3312  
    13311331    !IF(.NOT.clef_stations(iff)) THEN
    13321332        IF (.TRUE.) THEN
    1333             ALLOCATE(index2d(nbp_lon*jj_nb))
    1334             ALLOCATE(fieldok(nbp_lon*jj_nb))
    1335    
    13361333   
    13371334            CALL xios_send_field(field_name, Field2d)
    … …  
    13541351                ENDDO
    13551352            ENDIF
    1356    
    1357         ENDIF
    1358                  
    1359         DEALLOCATE(index2d)
    1360         DEALLOCATE(fieldok)
     1353            DEALLOCATE(index2d)
     1354            DEALLOCATE(fieldok)
     1355   
     1356        ENDIF                 
    13611357      ENDIF
    13621358!$OMP END MASTER   
    … …  
    14161412    !IF (.NOT.clef_stations(iff)) THEN
    14171413        IF(.TRUE.)THEN
    1418             ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
    1419             ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
    1420             CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
     1414
     1415           CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
    14211416                           
    14221417        ELSE
    … …  
    14411436                ENDDO
    14421437            ENDIF
     1438            DEALLOCATE(index3d)
     1439            DEALLOCATE(fieldok)
    14431440        ENDIF
    1444         DEALLOCATE(index3d)
    1445         DEALLOCATE(fieldok)
    14461441      ENDIF
    14471442!$OMP END MASTER   

  • LMDZ6/branches/DYNAMICO-conv/libf/phylmd/iostart.F90

    r2311 r3312  
    129129  USE netcdf
    130130  USE dimphy
     131  USE geometry_mod
    131132  USE mod_grid_phy_lmdz
    132133  USE mod_phys_lmdz_para
    … …  
    138139   
    139140    REAL    :: field_glo(klon_glo,field_size)
     141    REAL    :: field_glo_tmp(klon_glo,field_size)
     142    INTEGER :: ind_cell_glo_glo(klon_glo)
    140143    LOGICAL :: tmp_found
    141144    INTEGER :: varid
    142     INTEGER :: ierr
    143    
    144     IF (is_mpi_root .AND. is_omp_root) THEN
     145    INTEGER :: ierr,i
     146
     147!    IF (is_master) ALLOCATE(ind_cell_glo_glo(1:klon_glo))
     148    CALL gather(ind_cell_glo,ind_cell_glo_glo)
     149   
     150    IF (is_master) THEN
    145151 
    146152      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
    147153     
    148154      IF (ierr==NF90_NOERR) THEN
    149         CALL body(field_glo)
     155        CALL body(field_glo_tmp)
    150156        tmp_found=.TRUE.
    151157      ELSE
    … …  
    158164
    159165    IF (tmp_found) THEN
     166      IF (is_master) THEN 
     167        DO i=1,klon_glo
     168         field_glo(i,:)=field_glo_tmp(ind_cell_glo_glo(i),:)
     169        ENDDO
     170      ENDIF
    160171      CALL scatter(field_glo,field)
    161172    ENDIF
    … …  
    384395  USE netcdf
    385396  USE dimphy
     397  USE geometry_mod
    386398  USE mod_grid_phy_lmdz
    387399  USE mod_phys_lmdz_para
    … …  
    393405 
    394406  REAL                           :: field_glo(klon_glo,field_size)
    395   INTEGER                        :: ierr
     407  REAL                           :: field_glo_tmp(klon_glo,field_size)
     408!  INTEGER,ALLOCATABLE            :: ind_cell_glo_glo(:)
     409  INTEGER                        :: ind_cell_glo_glo(klon_glo)
     410  INTEGER                        :: ierr,i
    396411  INTEGER                        :: nvarid
    397412  INTEGER                        :: idim
    398413   
    399414   
    400     CALL gather(field,field_glo)
    401    
    402     IF (is_mpi_root .AND. is_omp_root) THEN
     415!    IF (is_master) ALLOCATE(ind_cell_glo_glo(klon_glo))
     416    CALL gather(ind_cell_glo,ind_cell_glo_glo)
     417
     418    CALL gather(field,field_glo_tmp)
     419   
     420    IF (is_master) THEN
     421
     422      DO i=1,klon_glo
     423       field_glo(ind_cell_glo_glo(i),:)=field_glo_tmp(i,:)
     424      ENDDO
     425
    403426
    404427      IF (field_size==1) THEN

  • LMDZ6/branches/DYNAMICO-conv/libf/phylmd/limit_read_mod.F90

    r2788 r3312  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44MODULE limit_read_mod
    … …  
    3131!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    3232
     33
     34  SUBROUTINE init_limit_read(first_day)
     35  USE mod_grid_phy_lmdz
     36  USE surface_data
     37  USE mod_phys_lmdz_para
     38#ifdef CPP_XIOS
     39  USE XIOS
     40#endif
     41  IMPLICIT NONE
     42    INTEGER, INTENT(IN) :: first_day
     43   
     44   
     45    IF ( type_ocean /= 'couple') THEN
     46      IF (grid_type==unstructured) THEN
     47#ifdef CPP_XIOS
     48        IF (is_omp_master) CALL xios_set_file_attr("limit_read",enabled=.TRUE.,record_offset=first_day)
     49#endif
     50      ENDIF 
     51    ENDIF
     52
     53  END SUBROUTINE init_limit_read
     54 
    3355  SUBROUTINE limit_read_frac(itime, dtime, jour, pctsrf_new, is_modified)
    3456!
    … …  
    150172    USE phys_cal_mod, ONLY : calend, year_len
    151173    USE print_control_mod, ONLY: lunout, prt_level
    152 
     174#ifdef CPP_XIOS
     175    USE XIOS, ONLY: xios_recv_field
     176#endif
     177   
    153178    IMPLICIT NONE
    154179   
    … …  
    179204    REAL, DIMENSION(klon_glo)                 :: rug_glo  ! rugosity at global grid
    180205    REAL, DIMENSION(klon_glo)                 :: alb_glo  ! albedo at global grid
     206
     207    REAL, DIMENSION(klon_mpi,nbsrf)           :: pct_mpi  ! fraction at global grid
     208    REAL, DIMENSION(klon_mpi)                 :: sst_mpi  ! sea-surface temperature at global grid
     209    REAL, DIMENSION(klon_mpi)                 :: rug_mpi  ! rugosity at global grid
     210    REAL, DIMENSION(klon_mpi)                 :: alb_mpi  ! albedo at global grid
     211
    181212    CHARACTER(len=20)                         :: modname='limit_read_mod'     
    182213    CHARACTER(LEN=99)                         :: abort_message, calendar, str
    … …  
    220251          END IF
    221252
    222           !--- ERROR IF FILE RECORDS NUMBER IS NOT EQUAL TO EXPECTED NUMBER OF DAYS
    223           ierr=NF90_INQUIRE(nid, UnlimitedDimID=ndimid)
     253          !--- ERROR IF FILE RECORDS NUMBER IS NOT EQUAL TO EXPECTED NUMBER OF DAYS         
     254          IF (grid_type==unstructured) THEN
     255            ierr=NF90_INQ_DIMID(nid,"time_year",ndimid)
     256          ELSE
     257            ierr=NF90_INQUIRE(nid, UnlimitedDimID=ndimid)
     258          ENDIF
    224259          ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn)
    225260          WRITE(abort_message,'(a,2(i3,a))')'limit.nc records number (',nn,') does no'//&
    … …  
    228263
    229264          !--- ERROR IF FILES AND LMDZ HORIZONTAL RESOLUTIONS DO NOT MATCH
    230           ierr=NF90_INQ_DIMID(nid, 'points_physiques', ndimid)
     265          IF (grid_type==unstructured) THEN
     266            ierr=NF90_INQ_DIMID(nid, 'cell', ndimid)
     267          ELSE
     268            ierr=NF90_INQ_DIMID(nid, 'points_physiques', ndimid)
     269          ENDIF
    231270          ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn)
    232271          WRITE(abort_message,'(a,2(i0,a))')'limit.nc horizontal number of cells (',nn, &
    … …  
    252291       jour_lu = jour
    253292       is_modified = .TRUE.
     293
     294      IF (grid_type==unstructured) THEN
     295
     296#ifdef CPP_XIOS
     297        IF ( type_ocean /= 'couple') THEN
     298
     299           IF (is_omp_master) CALL xios_recv_field("foce_limin",pct_mpi(:,is_oce))
     300           IF (is_omp_master) CALL xios_recv_field("fsic_limin",pct_mpi(:,is_sic))
     301  !         IF (read_continents .OR. itime == 1) THEN
     302           IF (is_omp_master) CALL xios_recv_field("fter_limin",pct_mpi(:,is_ter))
     303           IF (is_omp_master) CALL xios_recv_field("flic_limin",pct_mpi(:,is_lic))
     304  !         ENDIF
     305         ENDIF! type_ocean /= couple
     306         
     307         IF ( type_ocean /= 'couple') THEN                   
     308             IF (is_omp_master) CALL xios_recv_field("sst_limin",sst_mpi)
     309         ENDIF
     310       
     311         IF (.NOT. ok_veget) THEN
     312           IF (is_omp_master) CALL xios_recv_field("alb_limin",alb_mpi)
     313           IF (is_omp_master) CALL xios_recv_field("rug_limin",rug_mpi)
     314         ENDIF
     315
     316       IF ( type_ocean /= 'couple') THEN
     317          CALL Scatter_omp(sst_mpi,sst)
     318          CALL Scatter_omp(pct_mpi(:,is_oce),pctsrf(:,is_oce))
     319          CALL Scatter_omp(pct_mpi(:,is_sic),pctsrf(:,is_sic))
     320!          IF (read_continents .OR. itime == 1) THEN
     321             CALL Scatter_omp(pct_mpi(:,is_ter),pctsrf(:,is_ter))
     322             CALL Scatter_omp(pct_mpi(:,is_lic),pctsrf(:,is_lic))
     323!          END IF
     324       END IF
     325
     326       IF (.NOT. ok_veget) THEN
     327          CALL Scatter_omp(alb_mpi, albedo)
     328          CALL Scatter_omp(rug_mpi, rugos)
     329       END IF
     330#endif
     331
     332 
     333     ELSE      ! grid_type==regular
     334
    254335!$OMP MASTER  ! Only master thread
    255336       IF (is_mpi_root) THEN ! Only master processus
    … …  
    371452       END IF
    372453
     454      ENDIF ! Grid type
     455
    373456    ENDIF ! time to read
    374457

  • LMDZ6/branches/DYNAMICO-conv/libf/phylmd/phyaqua_mod.F90

    r2979 r3312  
    2929    USE indice_sol_mod
    3030    USE nrtype, ONLY: pi
    31     USE ioipsl
     31!    USE ioipsl
     32    USE mod_phys_lmdz_para, ONLY: is_master
     33    USE mod_phys_lmdz_transfert_para, ONLY: bcast
     34    USE mod_grid_phy_lmdz
     35    USE ioipsl_getin_p_mod, ONLY : getin_p
    3236    IMPLICIT NONE
    3337
    … …  
    5761    INTEGER it, unit, i, k, itap
    5862
    59     REAL airefi, zcufi, zcvfi
    60 
    6163    REAL rugos, albedo
    6264    REAL tsurf
    … …  
    6466    REAL qsol_f
    6567    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)
    6968    LOGICAL alb_ocean
    70     ! integer demih_pas
    7169
    7270    CHARACTER *80 ans, file_forctl, file_fordat, file_start
    … …  
    8684
    8785    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
     86!$OMP THREADPRIVATE(read_climoz)
     87
    9588    ! -------------------------------------------------------------------------
    9689    ! declaration pour l'appel a phyredem
    … …  
    117110    INTEGER l, ierr, aslun
    118111
    119 !    REAL longitude, latitude
    120112    REAL paire
    121113
    122 !    DATA latitude, longitude/48., 0./
    123114
    124115    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    148139    time = 0.
    149140
    150     ! IM ajout latfi, lonfi
    151 !    rlatd = latfi
    152 !    rlond = lonfi
    153 !    rlat = rlatd*180./pi
    154 !    rlon = rlond*180./pi
    155 
    156141    ! -----------------------------------------------------------------------
    157142    ! initialisations de la physique
    … …  
    160145    day_ini = day_ref
    161146    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
     147
     148    nbapp_rad = 24
     149    CALL getin_p('nbapp_rad', nbapp_rad)
    171150
    172151    ! ---------------------------------------------------------------------
    … …  
    175154    ! Initialisations des constantes
    176155    ! 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)
     156    co2_ppm = 348.
     157    CALL getin_p('co2_ppm', co2_ppm)
     158
     159    solaire = 1365.
     160    CALL getin_p('solaire', solaire)
     161 
    182162    ! CALL getin('albedo',albedo) ! albedo is set below, depending on
    183163    ! 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
     164    alb_ocean = .TRUE.
     165    CALL getin_p('alb_ocean', alb_ocean)
     166
    189167    WRITE (*, *) 'iniaqua: co2_ppm=', co2_ppm
    190     solaire = solaire_omp
    191168    WRITE (*, *) 'iniaqua: solaire=', solaire
    192     alb_ocean = alb_ocean_omp
    193169    WRITE (*, *) 'iniaqua: alb_ocean=', alb_ocean
    194170
    … …  
    226202    END IF
    227203
    228     !$OMP MASTER
    229     rugos_omp = rugos
    230     CALL getin('rugos', rugos_omp)
    231     !$OMP END MASTER
    232     !$OMP BARRIER
    233     rugos = rugos_omp
     204    CALL getin_p('rugos', rugos)
     205
    234206    WRITE (*, *) 'iniaqua: rugos=', rugos
    235207    zmasq(:) = pctsrf(:, is_ter)
    … …  
    262234    CALL profil_sst(nlon, latitude, type_profil, phy_sst)
    263235
    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 
     236    IF (grid_type==unstructured) THEN
     237      CALL writelim_unstruct(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, phy_ice, &
     238                             phy_fter, phy_foce, phy_flic, phy_fsic)
     239    ELSE
     240     
     241       CALL writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, phy_ice, &
     242                     phy_fter, phy_foce, phy_flic, phy_fsic)
     243    ENDIF
    267244
    268245    ! ---------------------------------------------------------------------
    … …  
    339316    PRINT *, 'iniaqua: before phyredem'
    340317
    341     pbl_tke(:,:,:)=1.e-8
     318    pbl_tke(:,:,:) = 1.e-8
    342319    falb1 = albedo
    343320    falb2 = albedo
    … …  
    349326    wake_deltaq = 0.
    350327    wake_s = 0.
    351     wake_dens = 0. 
     328    wake_dens = 0.
    352329    wake_cstar = 0.
    353330    wake_pe = 0.
    … …  
    360337    alp_bl =0.
    361338    treedrg(:,:,:)=0.
     339
     340!ym error : the sub surface dimension is the third not second : forgotten for iniaqua
     341!    falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
     342!    falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
     343    falb_dir(:,:,is_ter)=0.08; falb_dir(:,:,is_lic)=0.6
     344    falb_dir(:,:,is_oce)=0.5;  falb_dir(:,:,is_sic)=0.6
     345
     346!ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ?
     347!ym probably the uninitialized value was 0 for standard (regular grid) case
     348    falb_dif(:,:,:)=0
    362349
    363350
    … …  
    488475  ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    489476
    490   SUBROUTINE writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, &
     477  SUBROUTINE writelim_unstruct(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, &
    491478      phy_ice, phy_fter, phy_foce, phy_flic, phy_fsic)
    492479
    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
     480    USE mod_phys_lmdz_para, ONLY: is_omp_master, klon_mpi
     481    USE mod_phys_lmdz_transfert_para, ONLY: gather_omp
     482#ifdef CPP_XIOS
     483    USE xios
     484#endif
    496485    IMPLICIT NONE
     486
    497487    include "netcdf.inc"
    498488
    … …  
    509499    REAL, INTENT (IN) :: phy_fsic(klon, 360)
    510500
     501    REAL :: phy_mpi(klon_mpi, 360) ! temporary variable, to store phy_***(:)
     502      ! on the whole physics grid
     503 
     504#ifdef CPP_XIOS
     505    PRINT *, 'writelim: Ecriture du fichier limit'
     506
     507    CALL gather_omp(phy_foce, phy_mpi)
     508    IF (is_omp_master) CALL xios_send_field('foce_limout',phy_mpi)
     509
     510    CALL gather_omp(phy_fsic, phy_mpi)
     511    IF (is_omp_master) CALL xios_send_field('fsic_limout',phy_mpi)
     512     
     513    CALL gather_omp(phy_fter, phy_mpi)
     514    IF (is_omp_master) CALL xios_send_field('fter_limout',phy_mpi)
     515     
     516    CALL gather_omp(phy_flic, phy_mpi)
     517    IF (is_omp_master) CALL xios_send_field('flic_limout',phy_mpi)
     518
     519    CALL gather_omp(phy_sst, phy_mpi)
     520    IF (is_omp_master) CALL xios_send_field('sst_limout',phy_mpi)
     521
     522    CALL gather_omp(phy_bil, phy_mpi)
     523    IF (is_omp_master) CALL xios_send_field('bils_limout',phy_mpi)
     524
     525    CALL gather_omp(phy_alb, phy_mpi)
     526    IF (is_omp_master) CALL xios_send_field('alb_limout',phy_mpi)
     527
     528    CALL gather_omp(phy_rug, phy_mpi)
     529    IF (is_omp_master) CALL xios_send_field('rug_limout',phy_mpi)
     530#endif
     531  END SUBROUTINE writelim_unstruct
     532
     533
     534
     535  SUBROUTINE writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, &
     536      phy_ice, phy_fter, phy_foce, phy_flic, phy_fsic)
     537
     538    USE mod_phys_lmdz_para, ONLY: is_master
     539    USE mod_grid_phy_lmdz, ONLY: klon_glo
     540    USE mod_phys_lmdz_transfert_para, ONLY: gather
     541    IMPLICIT NONE
     542    include "netcdf.inc"
     543
     544    INTEGER, INTENT (IN) :: klon
     545    REAL, INTENT (IN) :: phy_nat(klon, 360)
     546    REAL, INTENT (IN) :: phy_alb(klon, 360)
     547    REAL, INTENT (IN) :: phy_sst(klon, 360)
     548    REAL, INTENT (IN) :: phy_bil(klon, 360)
     549    REAL, INTENT (IN) :: phy_rug(klon, 360)
     550    REAL, INTENT (IN) :: phy_ice(klon, 360)
     551    REAL, INTENT (IN) :: phy_fter(klon, 360)
     552    REAL, INTENT (IN) :: phy_foce(klon, 360)
     553    REAL, INTENT (IN) :: phy_flic(klon, 360)
     554    REAL, INTENT (IN) :: phy_fsic(klon, 360)
     555
    511556    REAL :: phy_glo(klon_glo, 360) ! temporary variable, to store phy_***(:)
    512557      ! on the whole physics grid
    … …  
    522567    INTEGER id_fter, id_foce, id_fsic, id_flic
    523568
    524     IF (is_mpi_root .AND. is_omp_root) THEN
     569    IF (is_master) THEN
    525570
    526571      PRINT *, 'writelim: Ecriture du fichier limit'
    527572
    528       ierr = nf_create('limit.nc', nf_clobber, nid)
     573      ierr = nf_create('limit.nc', NF_NETCDF4, nid)
    529574
    530575      ierr = nf_put_att_text(nid, nf_global, 'title', 30, &
    … …  
    627672      END DO
    628673
    629     END IF ! of if (is_mpi_root.and.is_omp_root)
     674    END IF ! of if (is_master)
    630675
    631676    ! write the fields, after having collected them on master
    632677
    633678    CALL gather(phy_nat, phy_glo)
    634     IF (is_mpi_root .AND. is_omp_root) THEN
     679    IF (is_master) THEN
    635680#ifdef NC_DOUBLE
    636681      ierr = nf_put_var_double(nid, id_nat, phy_glo)
    … …  
    645690
    646691    CALL gather(phy_sst, phy_glo)
    647     IF (is_mpi_root .AND. is_omp_root) THEN
     692    IF (is_master) THEN
    648693#ifdef NC_DOUBLE
    649694      ierr = nf_put_var_double(nid, id_sst, phy_glo)
    … …  
    658703
    659704    CALL gather(phy_bil, phy_glo)
    660     IF (is_mpi_root .AND. is_omp_root) THEN
     705    IF (is_master) THEN
    661706#ifdef NC_DOUBLE
    662707      ierr = nf_put_var_double(nid, id_bils, phy_glo)
    … …  
    671716
    672717    CALL gather(phy_alb, phy_glo)
    673     IF (is_mpi_root .AND. is_omp_root) THEN
     718    IF (is_master) THEN
    674719#ifdef NC_DOUBLE
    675720      ierr = nf_put_var_double(nid, id_alb, phy_glo)
    … …  
    684729
    685730    CALL gather(phy_rug, phy_glo)
    686     IF (is_mpi_root .AND. is_omp_root) THEN
     731    IF (is_master) THEN
    687732#ifdef NC_DOUBLE
    688733      ierr = nf_put_var_double(nid, id_rug, phy_glo)
    … …  
    697742
    698743    CALL gather(phy_fter, phy_glo)
    699     IF (is_mpi_root .AND. is_omp_root) THEN
     744    IF (is_master) THEN
    700745#ifdef NC_DOUBLE
    701746      ierr = nf_put_var_double(nid, id_fter, phy_glo)
    … …  
    710755
    711756    CALL gather(phy_foce, phy_glo)
    712     IF (is_mpi_root .AND. is_omp_root) THEN
     757    IF (is_master) THEN
    713758#ifdef NC_DOUBLE
    714759      ierr = nf_put_var_double(nid, id_foce, phy_glo)
    … …  
    723768
    724769    CALL gather(phy_fsic, phy_glo)
    725     IF (is_mpi_root .AND. is_omp_root) THEN
     770    IF (is_master) THEN
    726771#ifdef NC_DOUBLE
    727772      ierr = nf_put_var_double(nid, id_fsic, phy_glo)
    … …  
    736781
    737782    CALL gather(phy_flic, phy_glo)
    738     IF (is_mpi_root .AND. is_omp_root) THEN
     783    IF (is_master) THEN
    739784#ifdef NC_DOUBLE
    740785      ierr = nf_put_var_double(nid, id_flic, phy_glo)
    … …  
    749794
    750795    ! close file:
    751     IF (is_mpi_root .AND. is_omp_root) THEN
     796    IF (is_master) THEN
    752797      ierr = nf_close(nid)
    753798    END IF

  • LMDZ6/branches/DYNAMICO-conv/libf/phylmd/phys_state_var_mod.F90

    r3065 r3312  
    279279      REAL,ALLOCATABLE,SAVE :: total_rain(:), nday_rain(:) 
    280280!$OMP THREADPRIVATE(total_rain,nday_rain)
     281      REAL,ALLOCATABLE,SAVE :: paire_ter(:)
     282!$OMP THREADPRIVATE(paire_ter)
    281283! albsol1: albedo du sol total pour SW visible
    282284! albsol2: albedo du sol total pour SW proche IR
    … …  
    410412      ! tendencies on wind due to gravity waves
    411413
     414      LOGICAL,SAVE :: is_initialized=.FALSE.
     415!$OMP THREADPRIVATE(is_initialized)   
     416
    412417CONTAINS
    413418
    … …  
    430435include "clesphys.h"
    431436
     437      IF (is_initialized) RETURN
     438      is_initialized=.TRUE.
    432439      ALLOCATE(pctsrf(klon,nbsrf))
    433440      ALLOCATE(ftsol(klon,nbsrf))
    … …  
    540547      ALLOCATE(pfrac_1nucl(klon,klev))
    541548      ALLOCATE(total_rain(klon), nday_rain(klon))
     549      ALLOCATE(paire_ter(klon))
    542550      ALLOCATE(albsol1(klon), albsol2(klon))
    543551!albedo SB >>>
    … …  
    595603      ALLOCATE(ale_bl_trig(klon))
    596604!!! fin nrlmd le 10/04/2012
    597       if (ok_gwd_rando) allocate(du_gwd_rando(klon, klev))
     605      IF (ok_gwd_rando) THEN
     606        allocate(du_gwd_rando(klon, klev))
     607        du_gwd_rando(:,:)=0.
     608      ENDIF
    598609      if (.not. ok_hines .and. ok_gwd_rando) allocate(du_gwd_front(klon, klev))
    599610
    … …  
    680691      deallocate(pfrac_1nucl)
    681692      deallocate(total_rain, nday_rain)
     693      deallocate(paire_ter)
    682694      deallocate(albsol1, albsol2)
    683695!albedo SB >>>
    … …  
    727739      deallocate(ale_bl_trig)
    728740!!! fin nrlmd le 10/04/2012
    729 
     741      is_initialized=.FALSE.
    730742END SUBROUTINE phys_state_var_end
    731743

  • LMDZ6/branches/DYNAMICO-conv/libf/phylmd/write_histrac.h

    r2265 r3312  
    88     
    99     CALL histwrite_phy(nid_tra,.FALSE.,"phis",itau_w,pphis)
    10      CALL histwrite_phy(nid_tra,.FALSE.,"aire",itau_w,airephy)
     10     CALL histwrite_phy(nid_tra,.FALSE.,"aire",itau_w,cell_area)
    1111     CALL histwrite_phy(nid_tra,.FALSE.,"zmasse",itau_w,zmasse)
    1212! RomP >>>

  • LMDZ6/branches/DYNAMICO-conv/libf/phylmd/yamada4.F90

    r2952 r3312  
    739739  IMPLICIT NONE
    740740 
    741   include "dimensions.h"
    742 
    743741!    vdif_q2: subroutine qui calcule la diffusion de la TKE par la TKE
    744742!             avec un schema implicite en temps avec
    … …  
    830828  IMPLICIT NONE
    831829
    832   include "dimensions.h"
    833 !
    834830! vdif_q2e: subroutine qui calcule la diffusion de TKE par la TKE
    835831!           avec un schema explicite en temps
Note: See TracChangeset for help on using the changeset viewer.