Changeset 987 for LMDZ4/trunk


Ignore:
Timestamp:
Jul 30, 2008, 5:57:45 PM (16 years ago)
Author:
Laurent Fairhead
Message:

Du nettoyage sur le parallelisme, inclusion de nouvelles interfaces pour OPA9
et ORCHIDEE YM
LF

Location:
LMDZ4/trunk/libf/phylmd
Files:
2 added
25 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk/libf/phylmd/YOMCST2.h

    r963 r987  
    99     &               Supcrit1, Supcrit2,                                &
    1010     &               choice,iflag_mix
     11!$OMP THREADPRIVATE(/YOMCST2/)
    1112!    --------------------------------------------------------------------
    1213

  • LMDZ4/trunk/libf/phylmd/add_phys_tend.F90

    r972 r987  
    3838integer debug_level
    3939logical, save :: first=.true.
     40!$OMP THREADPRIVATE(first)
    4041INTEGER, SAVE :: itap
     42!$OMP THREADPRIVATE(itap)
    4143!======================================================================
    4244! Initialisations

  • LMDZ4/trunk/libf/phylmd/calltherm.F90

    r973 r987  
    8686      integer i,k
    8787      logical, save :: first=.true.
     88!$OMP THREADPRIVATE(first)
    8889!********************************************************
    8990      if (first) then

  • LMDZ4/trunk/libf/phylmd/comsoil.h

    r887 r987  
    55      common /comsoil/inertie_sol,inertie_sno,inertie_ice
    66      real inertie_sol,inertie_sno,inertie_ice
     7!$OMP THREADPRIVATE(/comsoil/)

  • LMDZ4/trunk/libf/phylmd/concvl.F

    r973 r987  
    151151      SAVE      h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
    152152     $        , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
     153c$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot)
     154c$OMP THREADPRIVATE(h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot)
    153155      REAL      d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
    154156      REAL      d_h_vcol_phy
    155157      REAL      fs_bound, fq_bound
    156158      SAVE      d_h_vcol_phy
     159c$OMP THREADPRIVATE(d_h_vcol_phy)
    157160      REAL      zero_v(klon)
    158161      CHARACTER*15 ztit
    … …  
    160163      SAVE      ip_ebil
    161164      DATA      ip_ebil/2/
     165c$OMP THREADPRIVATE(ip_ebil)
    162166      INTEGER   if_ebil ! level for energy conserv. dignostics
    163167      SAVE      if_ebil
    164168      DATA      if_ebil/2/
     169c$OMP THREADPRIVATE(if_ebil)
    165170c+jld ec_conser
    166171      REAL d_t_ec(klon,klev)    ! tendance du a la conersion Ec -> E thermique
    … …  
    170175      INTEGER nloc
    171176      logical, save :: first=.true.
    172       INTEGER, SAVE :: itap, igout
     177c$OMP THREADPRIVATE(first)
     178      INTEGER, SAVE :: itap, igout
     179c$OMP THREADPRIVATE(itap, igout)
    173180c
    174181#include "YOMCST.h"
    … …  
    229236C===========================================================================
    230237C
    231 c$$$         open (56,file='supcrit.data')
    232 c$$$         read (56,*) Supcrit1, Supcrit2
    233 c$$$         close (56)
     238cc$$$         open (56,file='supcrit.data')
     239cc$$$         read (56,*) Supcrit1, Supcrit2
     240cc$$$         close (56)
    234241c
    235242         print*, 'supcrit1, supcrit2' ,supcrit1, supcrit2

  • LMDZ4/trunk/libf/phylmd/cpl_mod.F90

    r836 r987  
    8888  !$OMP THREADPRIVATE(cpl_windsp2D)
    8989 
     90! variable for OPENMP parallelisation
     91
     92  INTEGER,ALLOCATABLE,DIMENSION(:),SAVE :: knon_omp
     93  REAL,ALLOCATABLE,DIMENSION(:,:),SAVE ::  buffer_omp
     94 
    9095
    9196CONTAINS
    … …  
    204209    idtime = INT(dtime)
    205210#ifdef CPP_COUPLE
     211!$OMP MASTER   
    206212    CALL inicma
     213!$OMP END MASTER
    207214#endif
    208215
    … …  
    252259    ENDIF    ! is_sequential
    253260   
     261! OPENMP Initialization
     262
     263!$OMP MASTER
     264  ALLOCATE(knon_omp(0:omp_size-1))
     265  ALLOCATE(buffer_omp(klon_mpi,0:omp_size-1))       
     266!$OMP END MASTER
     267!$OMP BARRIER
     268   
    254269  END SUBROUTINE cpl_init
    255270 
    … …  
    293308#ifdef CPP_COUPLE
    294309    il_time_secs=(itime-1)*dtime
     310!$OMP MASTER
    295311    CALL fromcpl(il_time_secs, tab_read_flds)
     312!$OMP END MASTER
    296313#endif
    297314   
    … …  
    305322    ENDIF
    306323
     324!$OMP MASTER
     325
    307326! Save each field in a 2D array.
    308     read_sst(:,:)     = tab_read_flds(:,:,1)  ! Sea surface temperature
    309     read_sic(:,:)     = tab_read_flds(:,:,2)  ! Sea ice concentration
    310     read_alb_sic(:,:) = tab_read_flds(:,:,3)  ! Albedo at sea ice
    311     read_sit(:,:)     = tab_read_flds(:,:,4)  ! Sea ice temperature
     327
     328    IF (OPA_version=='OPA9') THEN
     329      read_sst(:,:)     = tab_read_flds(:,:,1)  ! Sea surface temperature
     330      read_sic(:,:)     = tab_read_flds(:,:,2)  ! Sea ice concentration
     331      read_sit(:,:)     = tab_read_flds(:,:,3)  ! Sea ice temperature
     332      read_alb_sic(:,:) = tab_read_flds(:,:,4)  ! Albedo at sea ice
     333    ELSE IF (OPA_version=='OPA8') THEN
     334      read_sst(:,:)     = tab_read_flds(:,:,1)  ! Sea surface temperature
     335      read_sic(:,:)     = tab_read_flds(:,:,2)  ! Sea ice concentration
     336      read_alb_sic(:,:) = tab_read_flds(:,:,3)  ! Albedo at sea ice
     337      read_sit(:,:)     = tab_read_flds(:,:,4)  ! Sea ice temperature
     338    ELSE
     339      STOP 'Bad OPA version for coupled model'
     340    ENDIF
    312341
    313342!*************************************************************************************
    … …  
    332361       ENDDO
    333362    ENDDO
    334    
     363!$OMP END MASTER
     364
    335365!*************************************************************************************
    336366!  Transform seaice fraction, read_sic into pctsrf_sav
    … …  
    824854!
    825855!*************************************************************************************
     856!$OMP MASTER
    826857    rriv2D(:,:) = 0.0
    827858    rcoa2D(:,:) = 0.0
     859!$OMP END MASTER
    828860    CALL gath2cpl(rriv_in, rriv2D, knon, knindex)
    829861    CALL gath2cpl(rcoa_in, rcoa2D, knon, knindex)
    … …  
    834866!*************************************************************************************
    835867    IF (MOD(itime, nexca) == 1) THEN
     868!$OMP MASTER
    836869       cpl_rriv2D(:,:) = 0.0
    837870       cpl_rcoa2D(:,:) = 0.0
     871!$OMP END MASTER
    838872    ENDIF
    839873
    … …  
    842876!
    843877!*************************************************************************************   
     878!$OMP MASTER
    844879    cpl_rriv2D(:,:) = cpl_rriv2D(:,:) + rriv2D(:,:) / FLOAT(nexca)
    845880    cpl_rcoa2D(:,:) = cpl_rcoa2D(:,:) + rcoa2D(:,:) / FLOAT(nexca)
     881!$OMP END MASTER
    846882
    847883  END SUBROUTINE cpl_send_land_fields
    … …  
    874910!
    875911!*************************************************************************************
     912!$OMP MASTER
    876913    rlic2D(:,:) = 0.0
     914!$OMP END MASTER
    877915    CALL gath2cpl(rlic_in, rlic2D, knon, knindex)
    878916
    … …  
    882920!*************************************************************************************
    883921    IF (MOD(itime, nexca) == 1) THEN
     922!$OMP MASTER
    884923       cpl_rlic2D(:,:) = 0.0
     924!$OMP END MASTER
    885925    ENDIF
    886926
    … …  
    889929!
    890930!*************************************************************************************   
     931!$OMP MASTER
    891932    cpl_rlic2D(:,:) = cpl_rlic2D(:,:) + rlic2D(:,:) / FLOAT(nexca)
     933!$OMP END MASTER
    892934
    893935  END SUBROUTINE cpl_send_landice_fields
    … …  
    935977! Table with all fields to send to coupler
    936978    REAL, DIMENSION(iim, jj_nb, jpflda2o1+jpflda2o2)     :: tab_flds
     979    REAL, DIMENSION(klon_mpi)                            :: rlon_mpi, rlat_mpi
     980
    937981#ifdef CPP_PARA
    938982    INCLUDE 'mpif.h'
    … …  
    950994!
    951995!*************************************************************************************
    952     tab_flds(:,:,7)  = cpl_windsp2D(:,:)
    953     tab_flds(:,:,8)  = cpl_sols2D(:,:,2)
    954     tab_flds(:,:,9)  = cpl_sols2D(:,:,1)
    955     tab_flds(:,:,10) = cpl_nsol2D(:,:,2)
    956     tab_flds(:,:,11) = cpl_nsol2D(:,:,1)
    957     tab_flds(:,:,12) = cpl_fder2D(:,:,2)
    958     tab_flds(:,:,13) = cpl_evap2D(:,:,2)
    959     tab_flds(:,:,14) = cpl_evap2D(:,:,1)
    960     tab_flds(:,:,17) = cpl_rcoa2D(:,:)
    961     tab_flds(:,:,18) = cpl_rriv2D(:,:)
    962    
     996!! AC >>
     997
     998!$OMP MASTER
     999    IF (OPA_version=='OPA9') THEN
     1000      tab_flds(:,:,7)  = cpl_windsp2D(:,:)
     1001      tab_flds(:,:,14) = cpl_sols2D(:,:,2)
     1002      tab_flds(:,:,12) = cpl_sols2D(:,:,1)
     1003      tab_flds(:,:,15) = cpl_nsol2D(:,:,2)
     1004      tab_flds(:,:,13) = cpl_nsol2D(:,:,1)
     1005      tab_flds(:,:,16) = cpl_fder2D(:,:,2)
     1006      tab_flds(:,:,11) = cpl_evap2D(:,:,2)
     1007      tab_flds(:,:,18) = cpl_rriv2D(:,:)
     1008      tab_flds(:,:,19) = cpl_rcoa2D(:,:)
     1009    ELSE IF (OPA_version=='OPA8') THEN
     1010      tab_flds(:,:,7)  = cpl_windsp2D(:,:)
     1011      tab_flds(:,:,8)  = cpl_sols2D(:,:,2)
     1012      tab_flds(:,:,9)  = cpl_sols2D(:,:,1)
     1013      tab_flds(:,:,10) = cpl_nsol2D(:,:,2)
     1014      tab_flds(:,:,11) = cpl_nsol2D(:,:,1)
     1015      tab_flds(:,:,12) = cpl_fder2D(:,:,2)
     1016      tab_flds(:,:,13) = cpl_evap2D(:,:,2)
     1017      tab_flds(:,:,14) = cpl_evap2D(:,:,1)
     1018      tab_flds(:,:,17) = cpl_rcoa2D(:,:)
     1019      tab_flds(:,:,18) = cpl_rriv2D(:,:)
     1020    ELSE
     1021      STOP 'Bad OPA version for coupled model'
     1022    ENDIF
     1023
    9631024!*************************************************************************************
    9641025! Transform the fraction of sub-surfaces from 1D to 2D array
    … …  
    9661027!*************************************************************************************
    9671028    pctsrf2D(:,:,:) = 0.
     1029!$OMP END MASTER
     1030
    9681031    CALL gath2cpl(pctsrf(:,is_oce), pctsrf2D(:,:,is_oce), klon, unity)
    9691032    CALL gath2cpl(pctsrf(:,is_sic), pctsrf2D(:,:,is_sic), klon, unity)
    … …  
    9751038!
    9761039!*************************************************************************************     
    977     DO j = 1, jj_nb
    978        tmp_calv(:,j) = DOT_PRODUCT (cpl_rlic2D(1:iim,j), &
    979             pctsrf2D(1:iim,j,is_lic)) / REAL(iim)
    980     ENDDO
    981    
    982    
    983     IF (is_parallel) THEN
    984        IF (.NOT. is_north_pole) THEN
     1040    IF (is_omp_root) THEN
     1041
     1042      DO j = 1, jj_nb
     1043         tmp_calv(:,j) = DOT_PRODUCT (cpl_rlic2D(1:iim,j), &
     1044              pctsrf2D(1:iim,j,is_lic)) / REAL(iim)
     1045      ENDDO
     1046   
     1047   
     1048      IF (is_parallel) THEN
     1049         IF (.NOT. is_north_pole) THEN
    9851050#ifdef CPP_PARA
    986           CALL MPI_RECV(Up,1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,status,error)
    987           CALL MPI_SEND(tmp_calv(1,1),1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,error)
     1051            CALL MPI_RECV(Up,1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,status,error)
     1052            CALL MPI_SEND(tmp_calv(1,1),1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,error)
    9881053#endif
    989        ENDIF
     1054         ENDIF
    9901055       
    991        IF (.NOT. is_south_pole) THEN
     1056         IF (.NOT. is_south_pole) THEN
    9921057#ifdef CPP_PARA
    993           CALL MPI_SEND(tmp_calv(1,jj_nb),1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,error)
    994           CALL MPI_RECV(down,1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,status,error)
     1058            CALL MPI_SEND(tmp_calv(1,jj_nb),1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,error)
     1059            CALL MPI_RECV(down,1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,status,error)
    9951060#endif
    996        ENDIF
     1061         ENDIF
    9971062       
    998        IF (.NOT. is_north_pole .AND. ii_begin /=1) THEN
    999           Up=Up+tmp_calv(iim,1)
    1000           tmp_calv(:,1)=Up
    1001        ENDIF
     1063         IF (.NOT. is_north_pole .AND. ii_begin /=1) THEN
     1064            Up=Up+tmp_calv(iim,1)
     1065            tmp_calv(:,1)=Up
     1066         ENDIF
    10021067       
    1003        IF (.NOT. is_south_pole .AND. ii_end /= iim) THEN
    1004           Down=Down+tmp_calv(1,jj_nb)
    1005           tmp_calv(:,jj_nb)=Down         
    1006        ENDIF
    1007     ENDIF
    1008      
    1009 
    1010     tab_flds(:,:,19) = tmp_calv(:,:)
     1068         IF (.NOT. is_south_pole .AND. ii_end /= iim) THEN
     1069            Down=Down+tmp_calv(1,jj_nb)
     1070            tmp_calv(:,jj_nb)=Down       
     1071         ENDIF
     1072      ENDIF
     1073       
     1074      IF (OPA_version=='OPA9') THEN
     1075        tab_flds(:,:,17) = tmp_calv(:,:)
     1076      ELSE IF (OPA_version=='OPA8') THEN
     1077        tab_flds(:,:,17) = tmp_calv(:,:)
     1078      ELSE
     1079        STOP 'Bad OPA version for coupled model'
     1080      ENDIF
     1081
    10111082
    10121083!*************************************************************************************
    … …  
    10181089!
    10191090!*************************************************************************************   
    1020     tab_flds(:,:,15) = 0.0
    1021     tab_flds(:,:,16) = 0.0
    1022     tmp_taux(:,:)    = 0.0
    1023     tmp_tauy(:,:)    = 0.0
    1024    
    1025 
    1026     ! fraction oce+seaice
    1027     deno =  pctsrf2D(:,:,is_oce) + pctsrf2D(:,:,is_sic)
    1028     ! For all valid grid cells containing some fraction of ocean or sea-ice
    1029     WHERE ( deno(:,:) /= 0 )
    1030        tab_flds(:,:,15) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1031             cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1032        tab_flds(:,:,16) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1033             cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1091      ! fraction oce+seaice
     1092      deno =  pctsrf2D(:,:,is_oce) + pctsrf2D(:,:,is_sic)
     1093
     1094      IF (OPA_version=='OPA9') THEN
     1095
     1096        tab_flds(:,:,10) = 0.0
     1097        tmp_taux(:,:)    = 0.0
     1098        tmp_tauy(:,:)    = 0.0
     1099        ! fraction oce+seaice
     1100        ! For all valid grid cells containing some fraction of ocean or sea-ice
     1101        WHERE ( deno(:,:) /= 0 )
     1102           tab_flds(:,:,10) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1103                              cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1104
     1105           tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1106                      cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1107           tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1108                      cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1109        ENDWHERE
     1110        tab_flds(:,:,8) = (cpl_evap2D(:,:,1) - ( cpl_rain2D(:,:,1) + cpl_snow2D(:,:,1)))
     1111        tab_flds(:,:,9) = (cpl_evap2D(:,:,2) - ( cpl_rain2D(:,:,2) + cpl_snow2D(:,:,2)))
     1112
     1113      ELSE IF (OPA_version=='OPA8') THEN
     1114
     1115        tab_flds(:,:,15) = 0.0
     1116        tab_flds(:,:,16) = 0.0
     1117        tmp_taux(:,:)    = 0.0
     1118        tmp_tauy(:,:)    = 0.0
     1119        ! For all valid grid cells containing some fraction of ocean or sea-ice
     1120        WHERE ( deno(:,:) /= 0 )
     1121           tab_flds(:,:,15) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1122                              cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1123           tab_flds(:,:,16) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1124                              cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    10341125       
    1035        tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1036             cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1037        tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1038             cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1039     ENDWHERE
    1040 
     1126           tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1127                      cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1128           tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1129                      cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1130        ENDWHERE
     1131
     1132      ELSE
     1133        STOP 'Bad OPA version for coupled model'
     1134      ENDIF
     1135   
     1136    ENDIF ! is_omp_root 
     1137
     1138
     1139! AC <<
    10411140!*************************************************************************************
    10421141! Transform the wind components from local atmospheric 2D coordinates to geocentric
    … …  
    10461145
    10471146! Transform the longitudes and latitudes on 2D arrays
    1048     CALL Grid1DTo2D_mpi(rlon,tmp_lon)
    1049     CALL Grid1DTo2D_mpi(rlat,tmp_lat)
    1050    
     1147   
     1148    CALL gather_omp(rlon,rlon_mpi)
     1149    CALL gather_omp(rlat,rlat_mpi)
     1150!$OMP MASTER
     1151    CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon)
     1152    CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat)
     1153!$OMP END MASTER   
     1154
    10511155    IF (is_sequential) THEN
    10521156       IF (is_north_pole) tmp_lon(:,1)     = tmp_lon(:,2)
    … …  
    10661170! Transform the wind from local atmospheric 2D coordinates to geocentric
    10671171! 3D coordinates
     1172!$OMP MASTER
    10681173    CALL atm2geo (iim, jj_nb, tmp_taux, tmp_tauy, tmp_lon, tmp_lat, &
    10691174         tab_flds(:,:,1), tab_flds(:,:,2), tab_flds(:,:,3) )
    … …  
    10721177    tab_flds(:,:,5)  = tab_flds(:,:,2)
    10731178    tab_flds(:,:,6)  = tab_flds(:,:,3)
     1179!$OMP END MASTER
    10741180
    10751181!*************************************************************************************
    … …  
    11071213#ifdef CPP_COUPLE
    11081214    il_time_secs=(itime-1)*dtime
     1215!$OMP MASTER
    11091216    CALL intocpl(il_time_secs, lafin, tab_flds(:,:,:))
     1217!$OMP END MASTER
    11101218#endif
    11111219
    … …  
    11311239!
    11321240  SUBROUTINE cpl2gath(champ_in, champ_out, knon, knindex)
     1241  USE mod_phys_lmdz_para
    11331242! Cette routine ecrit un champ 'gathered' sur la grille 2D pour le passer
    11341243! au coupleur.
    … …  
    11511260
    11521261! Output
    1153     REAL, DIMENSION(klon), INTENT(OUT)        :: champ_out
     1262    REAL, DIMENSION(klon_mpi), INTENT(OUT)        :: champ_out
    11541263
    11551264! Local
    11561265    INTEGER                                   :: i, ig
    1157     REAL, DIMENSION(klon)                     :: tamp
    1158 
    1159 !*************************************************************************************
    1160 !
     1266    REAL, DIMENSION(klon_mpi)                 :: temp_mpi
     1267    REAL, DIMENSION(klon)                     :: temp_omp
     1268
     1269!*************************************************************************************
     1270!
     1271   
     1272
    11611273! Transform from 2 dimensions (iim,jj_nb) to 1 dimension (klon)
    1162     CALL Grid2Dto1D_mpi(champ_in,tamp)
    1163 
     1274!$OMP MASTER
     1275    CALL Grid2Dto1D_mpi(champ_in,temp_mpi)
     1276!$OMP END MASTER
     1277
     1278    CALL scatter_omp(temp_mpi,temp_omp)
     1279   
    11641280! Compress from klon to knon
    11651281    DO i = 1, knon
    11661282       ig = knindex(i)
    1167        champ_out(i) = tamp(ig)
     1283       champ_out(i) = temp_omp(ig)
    11681284    ENDDO
    1169 
     1285 
     1286   
    11701287  END SUBROUTINE cpl2gath
    11711288!
    … …  
    11731290!
    11741291  SUBROUTINE gath2cpl(champ_in, champ_out, knon, knindex)
     1292  USE mod_phys_lmdz_para
    11751293! Cette routine ecrit un champ 'gathered' sur la grille 2D pour le passer
    11761294! au coupleur.
    … …  
    11991317!*************************************************************************************
    12001318    INTEGER                                :: i, ig
    1201     REAL, DIMENSION(klon)                  :: tamp
    1202 
     1319    REAL, DIMENSION(klon)                  :: temp_omp
     1320    REAL, DIMENSION(klon_mpi)              :: temp_mpi
    12031321!*************************************************************************************
    12041322
    12051323! Decompress from knon to klon
    1206     tamp = 0.
     1324    temp_omp = 0.
    12071325    DO i = 1, knon
    12081326       ig = knindex(i)
    1209        tamp(ig) = champ_in(i)
     1327       temp_omp(ig) = champ_in(i)
    12101328    ENDDO
    12111329
    12121330! Transform from 1 dimension (klon) to 2 dimensions (iim,jj_nb)
    1213     CALL Grid1Dto2D_mpi(tamp,champ_out)
    1214    
    1215     IF (is_north_pole) champ_out(:,1)=tamp(1)
    1216     IF (is_south_pole) champ_out(:,jj_nb)=tamp(klon)
     1331    CALL gather_omp(temp_omp,temp_mpi)
     1332
     1333!$OMP MASTER   
     1334    CALL Grid1Dto2D_mpi(temp_mpi,champ_out)
     1335   
     1336    IF (is_north_pole) champ_out(:,1)=temp_mpi(1)
     1337    IF (is_south_pole) champ_out(:,jj_nb)=temp_mpi(klon)
     1338!$OMP END MASTER
    12171339   
    12181340  END SUBROUTINE gath2cpl

  • LMDZ4/trunk/libf/phylmd/cv3_inip.F

    r963 r987  
    5252C
    5353
    54 c$$$        open(57,file='parameter_mix.data')
    55 c$$$
    56 c$$$        read(57,*) iflag_mix, scut
    57 c$$$        read(57,*)
    58 c$$$        if(iflag_mix .gt. 0) then
    59 c$$$          read(57,*) qqa1, qqa2
    60 c$$$              read(57,*)
    61 c$$$              read(57,*) gammas, Fmax
    62 c$$$              read(57,*)
    63 c$$$              read(57,*) alphas
    64 c$$$         endif
    65 c$$$     close(57)
     54cc$$$        open(57,file='parameter_mix.data')
     55cc$$$
     56cc$$$        read(57,*) iflag_mix, scut
     57cc$$$        read(57,*)
     58cc$$$        if(iflag_mix .gt. 0) then
     59cc$$$         read(57,*) qqa1, qqa2
     60cc$$$              read(57,*)
     61cc$$$              read(57,*) gammas, Fmax
     62cc$$$              read(57,*)
     63cc$$$              read(57,*) alphas
     64cc$$$         endif
     65cc$$$    close(57)
    6666
    6767c

  • LMDZ4/trunk/libf/phylmd/cv3param.h

    r879 r987  
    2222     :                ,dtovsh, dpbase, dttrig
    2323     :                ,dtcrit, tau, beta, alpha, alpha1, delta, betad
     24!$OMP THREADPRIVATE(/cv3param/)
    2425

  • LMDZ4/trunk/libf/phylmd/cva_driver.F

    r973 r987  
    308308      logical ok_inhib  ! True => possible inhibition of convection by dryness
    309309      logical, save :: debut=.true.
     310c$OMP THREADPRIVATE(debut)
    310311
    311312      real plcl1(klon)
    … …  
    412413      real hnk(nloc),unk(nloc),vnk(nloc)
    413414      logical, save :: first=.true.
     415c$OMP THREADPRIVATE(first)
    414416
    415417c

  • LMDZ4/trunk/libf/phylmd/hgardfou.F

    r972 r987  
    2323      SAVE firstcall
    2424      DATA firstcall /.TRUE./
     25c$OMP THREADPRIVATE(firstcall)
     26
    2527      IF (firstcall) THEN
    2628         PRINT*, 'hgardfou garantit la temperature dans [100,370] K'

  • LMDZ4/trunk/libf/phylmd/inifis.F

    r766 r987  
    77     $           plat,plon,parea,
    88     $           prad,pg,pr,pcpp)
    9       use dimphy
     9      USE dimphy
    1010      IMPLICIT NONE
    1111c

  • LMDZ4/trunk/libf/phylmd/mod_phys_lmdz_transfert_para.F90

    r775 r987  
    276276    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    277277
    278     CALL body(VarIn,VarOut,SIZE(Varout,2))
    279    
    280   CONTAINS
    281     SUBROUTINE body(VarIn,VarOut,s1)
    282       INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
    283       INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    284       INTEGER,INTENT(IN) :: s1
    285       INTEGER,DIMENSION(klon_mpi,s1) :: Var_tmp
    286      
    287 !$OMP MASTER
    288         CALL scatter_mpi(VarIn,Var_tmp)
    289 !$OMP END MASTER
    290         CALL scatter_omp(Var_tmp,Varout)
    291     END SUBROUTINE body
    292 
     278    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
     279
     280!$OMP MASTER
     281      CALL scatter_mpi(VarIn,Var_tmp)
     282!$OMP END MASTER
     283      CALL scatter_omp(Var_tmp,Varout)
     284   
    293285  END SUBROUTINE scatter_i1
    294286
    … …  
    301293    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    302294   
    303     CALL body(VarIn,VarOut,SIZE(Varout,2),SIZE(Varout,3))
    304    
    305   CONTAINS
    306     SUBROUTINE body(VarIn,VarOut,s1,s2)
    307       INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    308       INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    309       INTEGER,INTENT(IN) :: s1,s2
    310       INTEGER,DIMENSION(klon_mpi,s1,s2) :: Var_tmp
    311      
    312 !$OMP MASTER
    313         CALL scatter_mpi(VarIn,Var_tmp)
    314 !$OMP END MASTER
    315         CALL scatter_omp(Var_tmp,Varout)
    316     END SUBROUTINE body
     295    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
     296
     297!$OMP MASTER
     298      CALL scatter_mpi(VarIn,Var_tmp)
     299!$OMP END MASTER
     300      CALL scatter_omp(Var_tmp,Varout)
    317301   
    318302  END SUBROUTINE scatter_i2
    … …  
    326310    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    327311
    328     CALL body(VarIn,VarOut,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,3))
    329    
    330   CONTAINS
    331     SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    332       INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    333       INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    334       INTEGER,INTENT(IN) :: s1,s2,s3
    335       INTEGER,DIMENSION(klon_mpi,s1,s2,s3) :: Var_tmp
    336      
    337 !$OMP MASTER
    338         CALL scatter_mpi(VarIn,Var_tmp)
    339 !$OMP END MASTER
    340         CALL scatter_omp(Var_tmp,Varout)
    341     END SUBROUTINE body
     312    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
     313
     314!$OMP MASTER
     315      CALL scatter_mpi(VarIn,Var_tmp)
     316!$OMP END MASTER
     317      CALL scatter_omp(Var_tmp,VarOut)
    342318   
    343319  END SUBROUTINE scatter_i3
    … …  
    369345    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    370346
    371     CALL body(VarIn,VarOut,SIZE(Varout,2))
    372    
    373   CONTAINS
    374     SUBROUTINE body(VarIn,VarOut,s1)
    375       REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
    376       REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    377       INTEGER,INTENT(IN) :: s1
    378       REAL,DIMENSION(klon_mpi,s1) :: Var_tmp
    379      
    380 !$OMP MASTER
    381         CALL scatter_mpi(VarIn,Var_tmp)
    382 !$OMP END MASTER
    383         CALL scatter_omp(Var_tmp,Varout)
    384     END SUBROUTINE body
     347    REAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
     348
     349!$OMP MASTER
     350      CALL scatter_mpi(VarIn,Var_tmp)
     351!$OMP END MASTER
     352      CALL scatter_omp(Var_tmp,Varout)
    385353   
    386354  END SUBROUTINE scatter_r1
    … …  
    394362    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    395363   
    396     CALL body(VarIn,VarOut,SIZE(Varout,2),SIZE(Varout,3))
    397    
    398   CONTAINS
    399     SUBROUTINE body(VarIn,VarOut,s1,s2)
    400       REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    401       REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    402       INTEGER,INTENT(IN) :: s1,s2
    403       REAL,DIMENSION(klon_mpi,s1,s2) :: Var_tmp
    404      
    405 !$OMP MASTER
    406         CALL scatter_mpi(VarIn,Var_tmp)
    407 !$OMP END MASTER
    408         CALL scatter_omp(Var_tmp,Varout)
    409     END SUBROUTINE body
     364    REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
     365
     366!$OMP MASTER
     367      CALL scatter_mpi(VarIn,Var_tmp)
     368!$OMP END MASTER
     369      CALL scatter_omp(Var_tmp,Varout)
    410370   
    411371  END SUBROUTINE scatter_r2
    … …  
    419379    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    420380
    421     CALL body(VarIn,VarOut,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,3))
    422    
    423   CONTAINS
    424     SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    425       REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    426       REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    427       INTEGER,INTENT(IN) :: s1,s2,s3
    428       REAL,DIMENSION(klon_mpi,s1,s2,s3) :: Var_tmp
    429      
    430 !$OMP MASTER
    431         CALL scatter_mpi(VarIn,Var_tmp)
    432 !$OMP END MASTER
    433         CALL scatter_omp(Var_tmp,Varout)
    434     END SUBROUTINE body
     381    REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
     382
     383!$OMP MASTER
     384      CALL scatter_mpi(VarIn,Var_tmp)
     385!$OMP END MASTER
     386      CALL scatter_omp(Var_tmp,VarOut)
    435387   
    436388  END SUBROUTINE scatter_r3
    … …  
    463415    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    464416
    465     CALL body(VarIn,VarOut,SIZE(Varout,2))
    466    
    467   CONTAINS
    468     SUBROUTINE body(VarIn,VarOut,s1)
    469       LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
    470       LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    471       INTEGER,INTENT(IN) :: s1
    472       LOGICAL,DIMENSION(klon_mpi,s1) :: Var_tmp
    473      
    474 !$OMP MASTER
    475         CALL scatter_mpi(VarIn,Var_tmp)
    476 !$OMP END MASTER
    477         CALL scatter_omp(Var_tmp,Varout)
    478     END SUBROUTINE body
     417    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
     418
     419!$OMP MASTER
     420      CALL scatter_mpi(VarIn,Var_tmp)
     421!$OMP END MASTER
     422      CALL scatter_omp(Var_tmp,Varout)
    479423   
    480424  END SUBROUTINE scatter_l1
    … …  
    488432    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    489433   
    490     CALL body(VarIn,VarOut,SIZE(Varout,2),SIZE(Varout,3))
    491    
    492   CONTAINS
    493     SUBROUTINE body(VarIn,VarOut,s1,s2)
    494       LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    495       LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    496       INTEGER,INTENT(IN) :: s1,s2
    497       LOGICAL,DIMENSION(klon_mpi,s1,s2) :: Var_tmp
    498      
    499 !$OMP MASTER
    500         CALL scatter_mpi(VarIn,Var_tmp)
    501 !$OMP END MASTER
    502         CALL scatter_omp(Var_tmp,Varout)
    503     END SUBROUTINE body
    504 
     434    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
     435
     436!$OMP MASTER
     437      CALL scatter_mpi(VarIn,Var_tmp)
     438!$OMP END MASTER
     439      CALL scatter_omp(Var_tmp,Varout)
     440   
    505441  END SUBROUTINE scatter_l2
    506442
    … …  
    513449    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    514450
    515     CALL body(VarIn,VarOut,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,3))
    516    
    517   CONTAINS
    518     SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    519       LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    520       LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    521       INTEGER,INTENT(IN) :: s1,s2,s3
    522       LOGICAL,DIMENSION(klon_mpi,s1,s2,s3) :: Var_tmp
    523      
    524 !$OMP MASTER
    525         CALL scatter_mpi(VarIn,Var_tmp)
    526 !$OMP END MASTER
    527         CALL scatter_omp(Var_tmp,Varout)
    528     END SUBROUTINE body
     451    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
     452
     453!$OMP MASTER
     454      CALL scatter_mpi(VarIn,Var_tmp)
     455!$OMP END MASTER
     456      CALL scatter_omp(Var_tmp,VarOut)
    529457   
    530458  END SUBROUTINE scatter_l3
    … …  
    562490    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    563491   
    564     CALL body(VarIn,VarOut,SIZE(VarIn,2))
    565    
    566   CONTAINS
    567     SUBROUTINE body(VarIn,VarOut,s1)
    568       INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
    569       INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    570       INTEGER,INTENT(IN) :: s1
    571       INTEGER,DIMENSION(klon_mpi,s1) :: Var_tmp
    572      
    573       CALL gather_omp(VarIn,Var_tmp)
    574 !$OMP MASTER
    575       CALL gather_mpi(Var_tmp,Varout)
    576 !$OMP END MASTER
    577 
    578     END SUBROUTINE body
     492    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
     493   
     494    CALL gather_omp(VarIn,Var_tmp)
     495!$OMP MASTER
     496    CALL gather_mpi(Var_tmp,Varout)
     497!$OMP END MASTER
    579498 
    580499  END SUBROUTINE gather_i1
    … …  
    588507    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    589508   
    590     CALL body(VarIn,VarOut,SIZE(VarIn,2),SIZE(VarIn,3))
    591    
    592   CONTAINS
    593     SUBROUTINE body(VarIn,VarOut,s1,s2)
    594       INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    595       INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    596       INTEGER,INTENT(IN) :: s1,s2
    597       INTEGER,DIMENSION(klon_mpi,s1,s2) :: Var_tmp
    598      
    599       CALL gather_omp(VarIn,Var_tmp)
    600 !$OMP MASTER
    601       CALL gather_mpi(Var_tmp,Varout)
    602 !$OMP END MASTER
    603 
    604     END SUBROUTINE body
     509    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
     510   
     511    CALL gather_omp(VarIn,Var_tmp)
     512!$OMP MASTER
     513    CALL gather_mpi(Var_tmp,VarOut)
     514!$OMP END MASTER
    605515 
    606516  END SUBROUTINE gather_i2
    … …  
    614524    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    615525   
    616     CALL body(VarIn,VarOut,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))
    617    
    618   CONTAINS
    619     SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    620       INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    621       INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    622       INTEGER,INTENT(IN) :: s1,s2,s3
    623       INTEGER,DIMENSION(klon_mpi,s1,s2,s3) :: Var_tmp
    624      
    625       CALL gather_omp(VarIn,Var_tmp)
    626 !$OMP MASTER
    627       CALL gather_mpi(Var_tmp,Varout)
    628 !$OMP END MASTER
    629 
    630     END SUBROUTINE body
     526    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
     527   
     528    CALL gather_omp(VarIn,Var_tmp)
     529!$OMP MASTER
     530    CALL gather_mpi(Var_tmp,VarOut)
     531!$OMP END MASTER
    631532 
    632533  END SUBROUTINE gather_i3
    … …  
    659560    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    660561   
    661     CALL body(VarIn,VarOut,SIZE(VarIn,2))
    662    
    663   CONTAINS
    664     SUBROUTINE body(VarIn,VarOut,s1)
    665       REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
    666       REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    667       INTEGER,INTENT(IN) :: s1
    668       REAL,DIMENSION(klon_mpi,s1) :: Var_tmp
    669      
    670       CALL gather_omp(VarIn,Var_tmp)
    671 !$OMP MASTER
    672       CALL gather_mpi(Var_tmp,Varout)
    673 !$OMP END MASTER
    674 
    675     END SUBROUTINE body
     562    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
     563   
     564    CALL gather_omp(VarIn,Var_tmp)
     565!$OMP MASTER
     566    CALL gather_mpi(Var_tmp,VarOut)
     567!$OMP END MASTER
    676568 
    677569  END SUBROUTINE gather_r1
    … …  
    685577    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    686578   
    687     CALL body(VarIn,VarOut,SIZE(VarIn,2),SIZE(VarIn,3))
    688    
    689   CONTAINS
    690     SUBROUTINE body(VarIn,VarOut,s1,s2)
    691       REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    692       REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    693       INTEGER,INTENT(IN) :: s1,s2
    694       REAL,DIMENSION(klon_mpi,s1,s2) :: Var_tmp
    695      
    696       CALL gather_omp(VarIn,Var_tmp)
    697 !$OMP MASTER
    698       CALL gather_mpi(Var_tmp,Varout)
    699 !$OMP END MASTER
    700 
    701     END SUBROUTINE body
     579    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
     580   
     581    CALL gather_omp(VarIn,Var_tmp)
     582!$OMP MASTER
     583    CALL gather_mpi(Var_tmp,VarOut)
     584!$OMP END MASTER
    702585 
    703586  END SUBROUTINE gather_r2
    … …  
    711594    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    712595   
    713     CALL body(VarIn,VarOut,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))
    714    
    715   CONTAINS
    716     SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    717       REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    718       REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    719       INTEGER,INTENT(IN) :: s1,s2,s3
    720       REAL,DIMENSION(klon_mpi,s1,s2,s3) :: Var_tmp
    721      
    722       CALL gather_omp(VarIn,Var_tmp)
    723 !$OMP MASTER
    724       CALL gather_mpi(Var_tmp,Varout)
    725 !$OMP END MASTER
    726 
    727     END SUBROUTINE body
     596    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
     597   
     598    CALL gather_omp(VarIn,Var_tmp)
     599!$OMP MASTER
     600    CALL gather_mpi(Var_tmp,VarOut)
     601!$OMP END MASTER
    728602 
    729603  END SUBROUTINE gather_r3
    … …  
    756630    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    757631   
    758     CALL body(VarIn,VarOut,SIZE(VarIn,2))
    759    
    760   CONTAINS
    761     SUBROUTINE body(VarIn,VarOut,s1)
    762       LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
    763       LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    764       INTEGER,INTENT(IN) :: s1
    765       LOGICAL,DIMENSION(klon_mpi,s1) :: Var_tmp
    766      
    767       CALL gather_omp(VarIn,Var_tmp)
    768 !$OMP MASTER
    769       CALL gather_mpi(Var_tmp,Varout)
    770 !$OMP END MASTER
    771 
    772     END SUBROUTINE body
     632    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
     633   
     634    CALL gather_omp(VarIn,Var_tmp)
     635!$OMP MASTER
     636    CALL gather_mpi(Var_tmp,VarOut)
     637!$OMP END MASTER
    773638 
    774639  END SUBROUTINE gather_l1
    … …  
    782647    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    783648   
    784     CALL body(VarIn,VarOut,SIZE(VarIn,2),SIZE(VarIn,3))
    785    
    786   CONTAINS
    787     SUBROUTINE body(VarIn,VarOut,s1,s2)
    788       LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    789       LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    790       INTEGER,INTENT(IN) :: s1,s2
    791       LOGICAL,DIMENSION(klon_mpi,s1,s2) :: Var_tmp
    792      
    793       CALL gather_omp(VarIn,Var_tmp)
    794 !$OMP MASTER
    795       CALL gather_mpi(Var_tmp,Varout)
    796 !$OMP END MASTER
    797 
    798     END SUBROUTINE body
     649    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
     650   
     651    CALL gather_omp(VarIn,Var_tmp)
     652!$OMP MASTER
     653    CALL gather_mpi(Var_tmp,VarOut)
     654!$OMP END MASTER
    799655 
    800656  END SUBROUTINE gather_l2
    … …  
    808664    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    809665   
    810     CALL body(VarIn,VarOut,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))
    811    
    812   CONTAINS
    813     SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    814       LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    815       LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    816       INTEGER,INTENT(IN) :: s1,s2,s3
    817       LOGICAL,DIMENSION(klon_mpi,s1,s2,s3) :: Var_tmp
    818      
    819       CALL gather_omp(VarIn,Var_tmp)
    820 !$OMP MASTER
    821       CALL gather_mpi(Var_tmp,Varout)
    822 !$OMP END MASTER
    823 
    824     END SUBROUTINE body
     666    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
     667   
     668    CALL gather_omp(VarIn,Var_tmp)
     669!$OMP MASTER
     670    CALL gather_mpi(Var_tmp,VarOut)
     671!$OMP END MASTER
    825672 
    826673  END SUBROUTINE gather_l3
    … …  
    858705    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    859706
    860     CALL body(VarIn,VarOut,SIZE(VarOut,2))
    861    
    862   CONTAINS
    863     SUBROUTINE body(VarIn,VarOut,s1)
    864       INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    865       INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    866       INTEGER,INTENT(IN) :: s1
    867       INTEGER,DIMENSION(klon_mpi,s1) :: Var_tmp
    868      
     707    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp   
     708
    869709!$OMP MASTER   
    870       CALL scatter2D_mpi(VarIn,Var_tmp)
    871 !$OMP END MASTER
    872       CALL scatter_omp(Var_tmp,VarOut)
    873 
    874     END SUBROUTINE body
     710    CALL scatter2D_mpi(VarIn,Var_tmp)
     711!$OMP END MASTER
     712    CALL scatter_omp(Var_tmp,VarOut)
    875713
    876714  END SUBROUTINE scatter2D_i1
    … …  
    884722    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    885723
    886     CALL body(VarIn,VarOut,SIZE(VarOut,2),SIZE(VarOut,3))
    887    
    888   CONTAINS
    889     SUBROUTINE body(VarIn,VarOut,s1,s2)
    890       INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    891       INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    892       INTEGER,INTENT(IN) :: s1,s2
    893       INTEGER,DIMENSION(klon_mpi,s1,s2) :: Var_tmp
    894      
     724    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp   
     725
    895726!$OMP MASTER   
    896       CALL scatter2D_mpi(VarIn,Var_tmp)
    897 !$OMP END MASTER
    898       CALL scatter_omp(Var_tmp,VarOut)
    899 
    900     END SUBROUTINE body
     727    CALL scatter2D_mpi(VarIn,Var_tmp)
     728!$OMP END MASTER
     729    CALL scatter_omp(Var_tmp,VarOut)
    901730
    902731  END SUBROUTINE scatter2D_i2 
    … …  
    910739    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    911740
    912     CALL body(VarIn,VarOut,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4))
    913    
    914   CONTAINS
    915     SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    916       INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
    917       INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    918       INTEGER,INTENT(IN) :: s1,s2,s3
    919       INTEGER,DIMENSION(klon_mpi,s1,s2,s3) :: Var_tmp
    920      
     741    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp   
     742
    921743!$OMP MASTER   
    922       CALL scatter2D_mpi(VarIn,Var_tmp)
    923 !$OMP END MASTER
    924       CALL scatter_omp(Var_tmp,VarOut)
    925 
    926     END SUBROUTINE body
     744    CALL scatter2D_mpi(VarIn,Var_tmp)
     745!$OMP END MASTER
     746    CALL scatter_omp(Var_tmp,VarOut)
    927747
    928748  END SUBROUTINE scatter2D_i3
    … …  
    955775    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    956776
    957     CALL body(VarIn,VarOut,SIZE(VarOut,2))
    958    
    959   CONTAINS
    960     SUBROUTINE body(VarIn,VarOut,s1)
    961       REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    962       REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    963       INTEGER,INTENT(IN) :: s1
    964       REAL,DIMENSION(klon_mpi,s1) :: Var_tmp
    965      
     777    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp   
     778
    966779!$OMP MASTER   
    967       CALL scatter2D_mpi(VarIn,Var_tmp)
    968 !$OMP END MASTER
    969       CALL scatter_omp(Var_tmp,VarOut)
    970 
    971     END SUBROUTINE body
     780    CALL scatter2D_mpi(VarIn,Var_tmp)
     781!$OMP END MASTER
     782    CALL scatter_omp(Var_tmp,VarOut)
    972783
    973784  END SUBROUTINE scatter2D_r1
    … …  
    981792    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    982793
    983     CALL body(VarIn,VarOut,SIZE(VarOut,2),SIZE(VarOut,3))
    984    
    985   CONTAINS
    986     SUBROUTINE body(VarIn,VarOut,s1,s2)
    987       REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    988       REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    989       INTEGER,INTENT(IN) :: s1,s2
    990       REAL,DIMENSION(klon_mpi,s1,s2) :: Var_tmp
    991      
     794    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp   
     795
    992796!$OMP MASTER   
    993       CALL scatter2D_mpi(VarIn,Var_tmp)
    994 !$OMP END MASTER
    995       CALL scatter_omp(Var_tmp,VarOut)
    996 
    997     END SUBROUTINE body
     797    CALL scatter2D_mpi(VarIn,Var_tmp)
     798!$OMP END MASTER
     799    CALL scatter_omp(Var_tmp,VarOut)
    998800
    999801  END SUBROUTINE scatter2D_r2 
    … …  
    1007809    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1008810
    1009     CALL body(VarIn,VarOut,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4))
    1010    
    1011   CONTAINS
    1012     SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    1013       REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
    1014       REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1015       INTEGER,INTENT(IN) :: s1,s2,s3
    1016       REAL,DIMENSION(klon_mpi,s1,s2,s3) :: Var_tmp
    1017      
     811    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp   
     812
    1018813!$OMP MASTER   
    1019       CALL scatter2D_mpi(VarIn,Var_tmp)
    1020 !$OMP END MASTER
    1021       CALL scatter_omp(Var_tmp,VarOut)
    1022 
    1023     END SUBROUTINE body
     814    CALL scatter2D_mpi(VarIn,Var_tmp)
     815!$OMP END MASTER
     816    CALL scatter_omp(Var_tmp,VarOut)
    1024817
    1025818  END SUBROUTINE scatter2D_r3
    … …  
    1053846    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    1054847
    1055     CALL body(VarIn,VarOut,SIZE(VarOut,2))
    1056    
    1057   CONTAINS
    1058     SUBROUTINE body(VarIn,VarOut,s1)
    1059       LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    1060       LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    1061       INTEGER,INTENT(IN) :: s1
    1062       LOGICAL,DIMENSION(klon_mpi,s1) :: Var_tmp
    1063      
     848    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp   
     849
    1064850!$OMP MASTER   
    1065       CALL scatter2D_mpi(VarIn,Var_tmp)
    1066 !$OMP END MASTER
    1067       CALL scatter_omp(Var_tmp,VarOut)
    1068 
    1069     END SUBROUTINE body
     851    CALL scatter2D_mpi(VarIn,Var_tmp)
     852!$OMP END MASTER
     853    CALL scatter_omp(Var_tmp,VarOut)
    1070854
    1071855  END SUBROUTINE scatter2D_l1
    … …  
    1079863    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1080864
    1081     CALL body(VarIn,VarOut,SIZE(VarOut,2),SIZE(VarOut,3))
    1082    
    1083   CONTAINS
    1084     SUBROUTINE body(VarIn,VarOut,s1,s2)
    1085       LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    1086       LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1087       INTEGER,INTENT(IN) :: s1,s2
    1088       LOGICAL,DIMENSION(klon_mpi,s1,s2) :: Var_tmp
    1089      
     865    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp   
     866
    1090867!$OMP MASTER   
    1091       CALL scatter2D_mpi(VarIn,Var_tmp)
    1092 !$OMP END MASTER
    1093       CALL scatter_omp(Var_tmp,VarOut)
    1094 
    1095     END SUBROUTINE body
     868    CALL scatter2D_mpi(VarIn,Var_tmp)
     869!$OMP END MASTER
     870    CALL scatter_omp(Var_tmp,VarOut)
    1096871
    1097872  END SUBROUTINE scatter2D_l2 
    … …  
    1105880    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1106881
    1107     CALL body(VarIn,VarOut,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4))
    1108    
    1109   CONTAINS
    1110     SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    1111       LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
    1112       LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1113       INTEGER,INTENT(IN) :: s1,s2,s3
    1114       LOGICAL,DIMENSION(klon_mpi,s1,s2,s3) :: Var_tmp
    1115      
     882    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp   
     883
    1116884!$OMP MASTER   
    1117       CALL scatter2D_mpi(VarIn,Var_tmp)
    1118 !$OMP END MASTER
    1119       CALL scatter_omp(Var_tmp,VarOut)
    1120 
    1121     END SUBROUTINE body
     885    CALL scatter2D_mpi(VarIn,Var_tmp)
     886!$OMP END MASTER
     887    CALL scatter_omp(Var_tmp,VarOut)
    1122888
    1123889  END SUBROUTINE scatter2D_l3
    … …  
    1150916    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
    1151917    IMPLICIT NONE
     918 
    1152919    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
    1153920    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1154921   
    1155     CALL body(VarIn,VarOut,SIZE(VarIn,2))
    1156    
    1157   CONTAINS
    1158     SUBROUTINE body(VarIn,VarOut,s1)
    1159       INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
    1160       INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1161       INTEGER,INTENT(IN) :: s1
    1162       INTEGER,DIMENSION(klon_mpi,s1) :: Var_tmp
    1163      
    1164       CALL gather_omp(VarIn,Var_tmp)
    1165 !$OMP MASTER
    1166       CALL gather2D_mpi(Var_tmp,VarOut)
     922    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
     923
     924    CALL gather_omp(VarIn,Var_tmp)
     925!$OMP MASTER
     926    CALL gather2D_mpi(Var_tmp,VarOut)
    1167927!$OMP END MASTER   
    1168 
    1169     END SUBROUTINE body
    1170928
    1171929  END SUBROUTINE gather2D_i1
    … …  
    1179937    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1180938   
    1181     CALL body(VarIn,VarOut,SIZE(VarIn,2),SIZE(VarIn,3))
    1182    
    1183   CONTAINS
    1184     SUBROUTINE body(VarIn,VarOut,s1,s2)
    1185       INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    1186       INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1187       INTEGER,INTENT(IN) :: s1,s2
    1188       INTEGER,DIMENSION(klon_mpi,s1,s2) :: Var_tmp
    1189      
    1190       CALL gather_omp(VarIn,Var_tmp)
    1191 !$OMP MASTER
    1192       CALL gather2D_mpi(Var_tmp,VarOut)
     939    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
     940
     941    CALL gather_omp(VarIn,Var_tmp)
     942!$OMP MASTER
     943    CALL gather2D_mpi(Var_tmp,VarOut)
    1193944!$OMP END MASTER   
    1194 
    1195     END SUBROUTINE body
    1196945
    1197946  END SUBROUTINE gather2D_i2
    … …  
    1205954    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
    1206955   
    1207     CALL body(VarIn,VarOut,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))
    1208    
    1209   CONTAINS
    1210     SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    1211       INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    1212       INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
    1213       INTEGER,INTENT(IN) :: s1,s2,s3
    1214       INTEGER,DIMENSION(klon_mpi,s1,s2,s3) :: Var_tmp
    1215      
    1216       CALL gather_omp(VarIn,Var_tmp)
    1217 !$OMP MASTER
    1218       CALL gather2D_mpi(Var_tmp,VarOut)
     956    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
     957
     958    CALL gather_omp(VarIn,Var_tmp)
     959!$OMP MASTER
     960    CALL gather2D_mpi(Var_tmp,VarOut)
    1219961!$OMP END MASTER   
    1220 
    1221     END SUBROUTINE body
    1222962
    1223963  END SUBROUTINE gather2D_i3
    … …  
    1250990    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1251991   
    1252     CALL body(VarIn,VarOut,SIZE(VarIn,2))
    1253    
    1254   CONTAINS
    1255     SUBROUTINE body(VarIn,VarOut,s1)
    1256       REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
    1257       REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1258       INTEGER,INTENT(IN) :: s1
    1259       REAL,DIMENSION(klon_mpi,s1) :: Var_tmp
    1260      
    1261       CALL gather_omp(VarIn,Var_tmp)
    1262 !$OMP MASTER
    1263       CALL gather2D_mpi(Var_tmp,VarOut)
     992    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
     993
     994    CALL gather_omp(VarIn,Var_tmp)
     995!$OMP MASTER
     996    CALL gather2D_mpi(Var_tmp,VarOut)
    1264997!$OMP END MASTER   
    1265 
    1266     END SUBROUTINE body
    1267998
    1268999  END SUBROUTINE gather2D_r1
    … …  
    12761007    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    12771008   
    1278     CALL body(VarIn,VarOut,SIZE(VarIn,2),SIZE(VarIn,3))
    1279    
    1280   CONTAINS
    1281     SUBROUTINE body(VarIn,VarOut,s1,s2)
    1282       REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    1283       REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1284       INTEGER,INTENT(IN) :: s1,s2
    1285       REAL,DIMENSION(klon_mpi,s1,s2) :: Var_tmp
    1286      
    1287       CALL gather_omp(VarIn,Var_tmp)
    1288 !$OMP MASTER
    1289       CALL gather2D_mpi(Var_tmp,VarOut)
     1009    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
     1010
     1011    CALL gather_omp(VarIn,Var_tmp)
     1012!$OMP MASTER
     1013    CALL gather2D_mpi(Var_tmp,VarOut)
    12901014!$OMP END MASTER   
    1291 
    1292     END SUBROUTINE body
    12931015
    12941016  END SUBROUTINE gather2D_r2
    … …  
    13021024    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
    13031025   
    1304     CALL body(VarIn,VarOut,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))
    1305    
    1306   CONTAINS
    1307     SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    1308       REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    1309       REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
    1310       INTEGER,INTENT(IN) :: s1,s2,s3
    1311       REAL,DIMENSION(klon_mpi,s1,s2,s3) :: Var_tmp
    1312      
    1313       CALL gather_omp(VarIn,Var_tmp)
    1314 !$OMP MASTER
    1315       CALL gather2D_mpi(Var_tmp,VarOut)
     1026    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
     1027
     1028    CALL gather_omp(VarIn,Var_tmp)
     1029!$OMP MASTER
     1030    CALL gather2D_mpi(Var_tmp,VarOut)
    13161031!$OMP END MASTER   
    1317 
    1318     END SUBROUTINE body
    13191032
    13201033  END SUBROUTINE gather2D_r3
    … …  
    13471060    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    13481061   
    1349     CALL body(VarIn,VarOut,SIZE(VarIn,2))
    1350    
    1351   CONTAINS
    1352     SUBROUTINE body(VarIn,VarOut,s1)
    1353       LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
    1354       LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1355       INTEGER,INTENT(IN) :: s1
    1356       LOGICAL,DIMENSION(klon_mpi,s1) :: Var_tmp
    1357      
    1358       CALL gather_omp(VarIn,Var_tmp)
    1359 !$OMP MASTER
    1360       CALL gather2D_mpi(Var_tmp,VarOut)
     1062    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
     1063
     1064    CALL gather_omp(VarIn,Var_tmp)
     1065!$OMP MASTER
     1066    CALL gather2D_mpi(Var_tmp,VarOut)
    13611067!$OMP END MASTER   
    1362 
    1363     END SUBROUTINE body
    13641068
    13651069  END SUBROUTINE gather2D_l1
    … …  
    13731077    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    13741078   
    1375     CALL body(VarIn,VarOut,SIZE(VarIn,2),SIZE(VarIn,3))
    1376    
    1377   CONTAINS
    1378     SUBROUTINE body(VarIn,VarOut,s1,s2)
    1379       LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    1380       LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1381       INTEGER,INTENT(IN) :: s1,s2
    1382       LOGICAL,DIMENSION(klon_mpi,s1,s2) :: Var_tmp
    1383      
    1384       CALL gather_omp(VarIn,Var_tmp)
    1385 !$OMP MASTER
    1386       CALL gather2D_mpi(Var_tmp,VarOut)
     1079    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
     1080
     1081    CALL gather_omp(VarIn,Var_tmp)
     1082!$OMP MASTER
     1083    CALL gather2D_mpi(Var_tmp,VarOut)
    13871084!$OMP END MASTER   
    1388 
    1389     END SUBROUTINE body
    13901085
    13911086  END SUBROUTINE gather2D_l2
    … …  
    13991094    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
    14001095   
    1401     CALL body(VarIn,VarOut,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))
    1402    
    1403   CONTAINS
    1404     SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    1405       LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    1406       LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
    1407       INTEGER,INTENT(IN) :: s1,s2,s3
    1408       LOGICAL,DIMENSION(klon_mpi,s1,s2,s3) :: Var_tmp
    1409      
    1410       CALL gather_omp(VarIn,Var_tmp)
    1411 !$OMP MASTER
    1412       CALL gather2D_mpi(Var_tmp,VarOut)
     1096    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
     1097
     1098    CALL gather_omp(VarIn,Var_tmp)
     1099!$OMP MASTER
     1100    CALL gather2D_mpi(Var_tmp,VarOut)
    14131101!$OMP END MASTER   
    1414 
    1415     END SUBROUTINE body
    14161102
    14171103  END SUBROUTINE gather2D_l3
    … …  
    14461132    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
    14471133   
    1448     CALL body(VarIn,VarOut,SIZE(VarIn,1))
    1449    
    1450   CONTAINS
    1451     SUBROUTINE body(VarIn,VarOut,s1)
    1452       INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
    1453       INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
    1454       INTEGER,INTENT(IN) :: s1
    1455       INTEGER,DIMENSION(s1) :: Var_tmp
    1456      
    1457       CALL reduce_sum_omp(VarIn,Var_tmp)
     1134    INTEGER,DIMENSION(SIZE(VarIn))   :: Var_tmp
     1135           
     1136    CALL reduce_sum_omp(VarIn,Var_tmp)
    14581137!$OMP MASTER     
    1459       CALL reduce_sum_mpi(Var_tmp,VarOut)
    1460 !$OMP END MASTER
    1461 
    1462     END SUBROUTINE body
     1138    CALL reduce_sum_mpi(Var_tmp,VarOut)
     1139!$OMP END MASTER
    14631140 
    14641141  END SUBROUTINE reduce_sum_i1 
    … …  
    14711148    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    14721149   
    1473     CALL body(VarIn,VarOut,SIZE(VarIn,1),SIZE(VarIn,2))
    1474    
    1475   CONTAINS
    1476     SUBROUTINE body(VarIn,VarOut,s1,s2)
    1477       INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
    1478       INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    1479       INTEGER,INTENT(IN) :: s1,s2
    1480       INTEGER,DIMENSION(s1,s2) :: Var_tmp
    1481      
    1482       CALL reduce_sum_omp(VarIn,Var_tmp)
     1150    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
     1151           
     1152    CALL reduce_sum_omp(VarIn,Var_tmp)
    14831153!$OMP MASTER     
    1484       CALL reduce_sum_mpi(Var_tmp,VarOut)
    1485 !$OMP END MASTER
    1486 
    1487     END SUBROUTINE body
     1154    CALL reduce_sum_mpi(Var_tmp,VarOut)
     1155!$OMP END MASTER
    14881156 
    14891157  END SUBROUTINE reduce_sum_i2 
    … …  
    14961164    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    14971165   
    1498     CALL body(VarIn,VarOut,SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))
    1499    
    1500   CONTAINS
    1501     SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    1502       INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    1503       INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1504       INTEGER,INTENT(IN) :: s1,s2,s3
    1505       INTEGER,DIMENSION(s1,s2,s3) :: Var_tmp
    1506      
    1507       CALL reduce_sum_omp(VarIn,Var_tmp)
     1166    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
     1167           
     1168    CALL reduce_sum_omp(VarIn,Var_tmp)
    15081169!$OMP MASTER     
    1509       CALL reduce_sum_mpi(Var_tmp,VarOut)
    1510 !$OMP END MASTER
    1511 
    1512     END SUBROUTINE body
     1170    CALL reduce_sum_mpi(Var_tmp,VarOut)
     1171!$OMP END MASTER
    15131172 
    15141173  END SUBROUTINE reduce_sum_i3 
    … …  
    15211180    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    15221181   
    1523     CALL body(VarIn,VarOut,SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))
    1524    
    1525   CONTAINS
    1526     SUBROUTINE body(VarIn,VarOut,s1,s2,s3,s4)
    1527       INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    1528       INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1529       INTEGER,INTENT(IN) :: s1,s2,s3,s4
    1530       INTEGER,DIMENSION(s1,s2,s3,s4) :: Var_tmp
    1531      
    1532       CALL reduce_sum_omp(VarIn,Var_tmp)
     1182    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
     1183           
     1184    CALL reduce_sum_omp(VarIn,Var_tmp)
    15331185!$OMP MASTER     
    1534       CALL reduce_sum_mpi(Var_tmp,VarOut)
    1535 !$OMP END MASTER
    1536 
    1537     END SUBROUTINE body
    1538    
     1186    CALL reduce_sum_mpi(Var_tmp,VarOut)
     1187!$OMP END MASTER
     1188 
    15391189  END SUBROUTINE reduce_sum_i4 
    15401190
    … …  
    15641214    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
    15651215   
    1566     CALL body(VarIn,VarOut,SIZE(VarIn,1))
    1567    
    1568   CONTAINS
    1569     SUBROUTINE body(VarIn,VarOut,s1)
    1570       REAL,INTENT(IN),DIMENSION(:) :: VarIn
    1571       REAL,INTENT(OUT),DIMENSION(:) :: VarOut
    1572       INTEGER,INTENT(IN) :: s1
    1573       REAL,DIMENSION(s1) :: Var_tmp
    1574      
    1575       CALL reduce_sum_omp(VarIn,Var_tmp)
     1216    REAL,DIMENSION(SIZE(VarIn))   :: Var_tmp
     1217           
     1218    CALL reduce_sum_omp(VarIn,Var_tmp)
    15761219!$OMP MASTER     
    1577       CALL reduce_sum_mpi(Var_tmp,VarOut)
    1578 !$OMP END MASTER
    1579 
    1580     END SUBROUTINE body
     1220    CALL reduce_sum_mpi(Var_tmp,VarOut)
     1221!$OMP END MASTER
    15811222 
    15821223  END SUBROUTINE reduce_sum_r1 
    … …  
    15891230    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    15901231   
    1591     CALL body(VarIn,VarOut,SIZE(VarIn,1),SIZE(VarIn,2))
    1592    
    1593   CONTAINS
    1594     SUBROUTINE body(VarIn,VarOut,s1,s2)
    1595       REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
    1596       REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    1597       INTEGER,INTENT(IN) :: s1,s2
    1598       REAL,DIMENSION(s1,s2) :: Var_tmp
    1599      
    1600       CALL reduce_sum_omp(VarIn,Var_tmp)
     1232    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
     1233           
     1234    CALL reduce_sum_omp(VarIn,Var_tmp)
    16011235!$OMP MASTER     
    1602       CALL reduce_sum_mpi(Var_tmp,VarOut)
    1603 !$OMP END MASTER
    1604 
    1605     END SUBROUTINE body
     1236    CALL reduce_sum_mpi(Var_tmp,VarOut)
     1237!$OMP END MASTER
    16061238 
    16071239  END SUBROUTINE reduce_sum_r2 
    … …  
    16141246    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    16151247   
    1616     CALL body(VarIn,VarOut,SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))
    1617    
    1618   CONTAINS
    1619     SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    1620       REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    1621       REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1622       INTEGER,INTENT(IN) :: s1,s2,s3
    1623       REAL,DIMENSION(s1,s2,s3) :: Var_tmp
    1624      
    1625       CALL reduce_sum_omp(VarIn,Var_tmp)
     1248    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
     1249           
     1250    CALL reduce_sum_omp(VarIn,Var_tmp)
    16261251!$OMP MASTER     
    1627       CALL reduce_sum_mpi(Var_tmp,VarOut)
    1628 !$OMP END MASTER
    1629 
    1630     END SUBROUTINE body
     1252    CALL reduce_sum_mpi(Var_tmp,VarOut)
     1253!$OMP END MASTER
    16311254 
    16321255  END SUBROUTINE reduce_sum_r3 
    … …  
    16391262    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    16401263   
    1641     CALL body(VarIn,VarOut,SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))
    1642    
    1643   CONTAINS
    1644     SUBROUTINE body(VarIn,VarOut,s1,s2,s3,s4)
    1645       REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    1646       REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1647       INTEGER,INTENT(IN) :: s1,s2,s3,s4
    1648       REAL,DIMENSION(s1,s2,s3,s4) :: Var_tmp
    1649      
    1650       CALL reduce_sum_omp(VarIn,Var_tmp)
     1264    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
     1265           
     1266    CALL reduce_sum_omp(VarIn,Var_tmp)
    16511267!$OMP MASTER     
    1652       CALL reduce_sum_mpi(Var_tmp,VarOut)
    1653 !$OMP END MASTER
    1654 
    1655     END SUBROUTINE body
    1656    
     1268    CALL reduce_sum_mpi(Var_tmp,VarOut)
     1269!$OMP END MASTER
     1270 
    16571271  END SUBROUTINE reduce_sum_r4 
    16581272

  • LMDZ4/trunk/libf/phylmd/oasis.F90

    r793 r987  
    4444  !$OMP THREADPRIVATE(out_var_id)
    4545
     46  CHARACTER(LEN=*),PARAMETER :: OPA_version='OPA9'
    4647
    4748#ifdef CPP_COUPLE
    … …  
    129130!     Define symbolic name for fields exchanged from atmos to coupler,
    130131!         must be the same as (1) of the field  definition in namcouple:
    131     cl_writ(1)='COTAUXXU'
    132     cl_writ(2)='COTAUYYU'
    133     cl_writ(3)='COTAUZZU'
    134     cl_writ(4)='COTAUXXV'
    135     cl_writ(5)='COTAUYYV'
    136     cl_writ(6)='COTAUZZV'
    137     cl_writ(7)='COWINDSP'
    138     cl_writ(8)='COSHFICE'
    139     cl_writ(9)='COSHFOCE'
    140     cl_writ(10)='CONSFICE'
    141     cl_writ(11)='CONSFOCE'
    142     cl_writ(12)='CODFLXDT'
    143     cl_writ(13)='COTFSICE'
    144     cl_writ(14)='COTFSOCE'
    145     cl_writ(15)='COTOLPSU'
    146     cl_writ(16)='COTOSPSU'
    147     cl_writ(17)='CORUNCOA'
    148     cl_writ(18)='CORIVFLU'
    149     cl_writ(19)='COCALVIN'
     132    IF (OPA_version=='OPA9') THEN
     133      cl_writ(1)='COTAUXXU'
     134      cl_writ(2)='COTAUYYU'
     135      cl_writ(3)='COTAUZZU'
     136      cl_writ(4)='COTAUXXV'
     137      cl_writ(5)='COTAUYYV'
     138      cl_writ(6)='COTAUZZV'
     139      cl_writ(7)='COWINDSP'
     140      cl_writ(8)='COPEFWAT'
     141      cl_writ(9)='COPEFICE'
     142      cl_writ(10)='COTOSPSU'
     143      cl_writ(11)='COICEVAP'
     144      cl_writ(12)='COSWFLDO'
     145      cl_writ(13)='CONSFLDO'
     146      cl_writ(14)='COSHFLIC'
     147      cl_writ(15)='CONSFLIC'
     148      cl_writ(16)='CODFLXDT'
     149      cl_writ(17)='CRWOCEIS'
     150      cl_writ(18)='CRWOCERD'
     151      cl_writ(19)='CRWOCECD'
     152    ELSE IF (OPA_version=='OPA8') THEN
     153      cl_writ(1)='COTAUXXU'
     154      cl_writ(2)='COTAUYYU'
     155      cl_writ(3)='COTAUZZU'
     156      cl_writ(4)='COTAUXXV'
     157      cl_writ(5)='COTAUYYV'
     158      cl_writ(6)='COTAUZZV'
     159      cl_writ(7)='COWINDSP'
     160      cl_writ(8)='COSHFICE'
     161      cl_writ(9)='COSHFOCE'
     162      cl_writ(10)='CONSFICE'
     163      cl_writ(11)='CONSFOCE'
     164      cl_writ(12)='CODFLXDT'
     165      cl_writ(13)='COTFSICE'
     166      cl_writ(14)='COTFSOCE'
     167      cl_writ(15)='COTOLPSU'
     168      cl_writ(16)='COTOSPSU'
     169      cl_writ(17)='CORUNCOA'
     170      cl_writ(18)='CORIVFLU'
     171      cl_writ(19)='COCALVIN'
     172    ELSE
     173      STOP 'Bad OPA version for coupled model'
     174    ENDIF
     175
    150176!
    151177!     Define symbolic name for fields exchanged from coupler to atmosphere,
    152178!         must be the same as (2) of the field  definition in namcouple:
    153179!
    154     cl_read(1)='SISUTESW'
    155     cl_read(2)='SIICECOV'
    156     cl_read(3)='SIICEALW'
    157     cl_read(4)='SIICTEMW'
     180    IF (OPA_version=='OPA9') THEN
     181      cl_read(1)='SISUTESW'
     182      cl_read(2)='SIICECOV'
     183      cl_read(4)='SIICEALW'
     184      cl_read(3)='SIICTEMW'
     185    ELSE IF (OPA_version=='OPA8') THEN
     186      cl_read(1)='SISUTESW'
     187      cl_read(2)='SIICECOV'
     188      cl_read(3)='SIICEALW'
     189      cl_read(4)='SIICTEMW'
     190    ELSE
     191      STOP 'Bad OPA version for coupled model'
     192    ENDIF
    158193   
    159194    il_var_nodims(1) = 2
    … …  
    286321! Local variables
    287322!************************************************************************************
    288     LOGICAL                     :: checkout=.FALSE.
    289     INTEGER                     :: istart,iend
    290     INTEGER                     :: wstart,wend
    291     INTEGER, PARAMETER          :: nuout = 6
    292     INTEGER                     :: ierror, i
    293     REAL, DIMENSION(iim*jj_nb)  :: field
    294     CHARACTER (len = 20),SAVE   :: modname = 'intocpl'
    295     CHARACTER (len = 80)        :: abort_message
    296 
    297 !************************************************************************************
     323    LOGICAL                          :: checkout
     324    INTEGER                          :: istart,iend
     325    INTEGER                          :: wstart,wend
     326    INTEGER, PARAMETER               :: nuout = 6
     327    INTEGER                          :: ierror, i
     328    REAL, DIMENSION(iim*jj_nb)       :: field
     329    CHARACTER (len = 20),PARAMETER   :: modname = 'intocpl'
     330    CHARACTER (len = 80)             :: abort_message
     331
     332!************************************************************************************
     333    checkout=.FALSE.
    298334
    299335    WRITE(nuout,*) ' '

  • LMDZ4/trunk/libf/phylmd/pbl_surface_mod.F90

    r972 r987  
    487487  LOGICAL ok_flux_surf
    488488  data ok_flux_surf/.false./
     489!ym pas glop !!
    489490    common /flux_arp/fsens,flat,ok_flux_surf
     491!$OMP THREADPRIVATE(/flux_arp/)
    490492
    491493!****************************************************************************************

  • LMDZ4/trunk/libf/phylmd/phyetat0.F

    r982 r987  
    109109      PARAMETER (length=100)
    110110      REAL tab_cntrl(length), tabcntr0(length)
    111       REAL,SAVE :: tab_cntrl_omp(length)
    112111      CHARACTER*7 str7
    113112      CHARACTER*2 str2
    … …  
    232231c Lecture des latitudes (coordonnees):
    233232c
    234 c$OMP MASTER
    235       IF (is_mpi_root) THEN
     233      IF (is_mpi_root .AND. is_omp_root) THEN
    236234     
    237235      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
    … …  
    957955      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
    958956     
    959       ENDIF  ! is_mpi_root
    960 c$OMP END MASTER
    961 
    962 
    963 c$OMP MASTER
    964       IF (is_mpi_root) THEN
    965957c
    966958c Lecture derive des flux:
    … …  
    17291721c
    17301722      ierr = NF_CLOSE(nid)
    1731       ENDIF ! is_mpi_root
    1732 c
    1733 c$OMP END MASTER
     1723      ENDIF ! is_mpi_root .AND. is_omp_root
     1724c
    17341725
    17351726c$OMP MASTER

  • LMDZ4/trunk/libf/phylmd/phys_local_var_mod.F90

    r909 r987  
    77! Declaration des variables
    88
    9       REAL, ALLOCATABLE :: t_seri(:,:), q_seri(:,:)
    10       REAL, ALLOCATABLE :: ql_seri(:,:),qs_seri(:,:)
    11       REAL, ALLOCATABLE :: u_seri(:,:), v_seri(:,:)
     9      REAL, SAVE, ALLOCATABLE :: t_seri(:,:), q_seri(:,:)
     10      !$OMP THREADPRIVATE(t_seri, q_seri)
     11      REAL, SAVE, ALLOCATABLE :: ql_seri(:,:),qs_seri(:,:)
     12      !$OMP THREADPRIVATE(ql_seri,qs_seri)
     13      REAL, SAVE, ALLOCATABLE :: u_seri(:,:), v_seri(:,:)
     14      !$OMP THREADPRIVATE(u_seri, v_seri)
    1215
    13       REAL, ALLOCATABLE :: tr_seri(:,:,:)
    14       REAL, ALLOCATABLE :: d_t_dyn(:,:), d_q_dyn(:,:)
    15       REAL, ALLOCATABLE :: d_t_con(:,:),d_q_con(:,:)
    16       REAL, ALLOCATABLE :: d_u_con(:,:),d_v_con(:,:)
    17       REAL, ALLOCATABLE :: d_t_wake(:,:),d_q_wake(:,:)
    18       REAL, ALLOCATABLE :: d_t_lsc(:,:),d_q_lsc(:,:),d_ql_lsc(:,:)
    19       REAL, ALLOCATABLE :: d_t_ajsb(:,:), d_q_ajsb(:,:)
    20       REAL, ALLOCATABLE :: d_t_ajs(:,:), d_q_ajs(:,:)
    21       REAL, ALLOCATABLE :: d_u_ajs(:,:), d_v_ajs(:,:)
    22       REAL, ALLOCATABLE :: d_t_eva(:,:),d_q_eva(:,:)
     16      REAL, SAVE, ALLOCATABLE :: tr_seri(:,:,:)
     17      !$OMP THREADPRIVATE(tr_seri)
     18      REAL, SAVE, ALLOCATABLE :: d_t_dyn(:,:), d_q_dyn(:,:)
     19      !$OMP THREADPRIVATE(d_t_dyn, d_q_dyn)
     20      REAL, SAVE, ALLOCATABLE :: d_t_con(:,:),d_q_con(:,:)
     21      !$OMP THREADPRIVATE(d_t_con,d_q_con)
     22      REAL, SAVE, ALLOCATABLE :: d_u_con(:,:),d_v_con(:,:)
     23      !$OMP THREADPRIVATE(d_u_con,d_v_con)
     24      REAL, SAVE, ALLOCATABLE :: d_t_wake(:,:),d_q_wake(:,:)
     25      !$OMP THREADPRIVATE( d_t_wake,d_q_wake)
     26      REAL, SAVE, ALLOCATABLE :: d_t_lsc(:,:),d_q_lsc(:,:),d_ql_lsc(:,:)
     27      !$OMP THREADPRIVATE(d_t_lsc,d_q_lsc,d_ql_lsc)
     28      REAL, SAVE, ALLOCATABLE :: d_t_ajsb(:,:), d_q_ajsb(:,:)
     29      !$OMP THREADPRIVATE(d_t_ajsb, d_q_ajsb)
     30      REAL, SAVE, ALLOCATABLE :: d_t_ajs(:,:), d_q_ajs(:,:)
     31      !$OMP THREADPRIVATE(d_t_ajs, d_q_ajs)
     32      REAL, SAVE, ALLOCATABLE :: d_u_ajs(:,:), d_v_ajs(:,:)
     33      !$OMP THREADPRIVATE(d_u_ajs, d_v_ajs)
     34      REAL, SAVE, ALLOCATABLE :: d_t_eva(:,:),d_q_eva(:,:)
     35      !$OMP THREADPRIVATE(d_t_eva,d_q_eva)
    2336!tendances dues a oro et lif
    24       REAL, ALLOCATABLE :: d_t_oli(:,:)
    25       REAL, ALLOCATABLE :: d_u_oli(:,:), d_v_oli(:,:)
    26       REAL, ALLOCATABLE :: d_t_vdf(:,:), d_q_vdf(:,:)
    27       REAL, ALLOCATABLE :: d_u_vdf(:,:), d_v_vdf(:,:)
    28       REAL, ALLOCATABLE :: d_t_oro(:,:)
    29       REAL, ALLOCATABLE :: d_u_oro(:,:), d_v_oro(:,:)
    30       REAL, ALLOCATABLE :: d_t_lif(:,:)
    31       REAL, ALLOCATABLE :: d_u_lif(:,:), d_v_lif(:,:)
     37      REAL, SAVE, ALLOCATABLE :: d_t_oli(:,:)
     38      !$OMP THREADPRIVATE(d_t_oli)
     39      REAL, SAVE, ALLOCATABLE :: d_u_oli(:,:), d_v_oli(:,:)
     40      !$OMP THREADPRIVATE(d_u_oli, d_v_oli)
     41      REAL, SAVE, ALLOCATABLE :: d_t_vdf(:,:), d_q_vdf(:,:)
     42      !$OMP THREADPRIVATE( d_t_vdf, d_q_vdf)
     43      REAL, SAVE, ALLOCATABLE :: d_u_vdf(:,:), d_v_vdf(:,:)
     44      !$OMP THREADPRIVATE(d_u_vdf, d_v_vdf)
     45      REAL, SAVE, ALLOCATABLE :: d_t_oro(:,:)
     46      !$OMP THREADPRIVATE(d_t_oro)
     47      REAL, SAVE, ALLOCATABLE :: d_u_oro(:,:), d_v_oro(:,:)
     48      !$OMP THREADPRIVATE(d_u_oro, d_v_oro)
     49      REAL, SAVE, ALLOCATABLE :: d_t_lif(:,:)
     50      !$OMP THREADPRIVATE(d_t_lif)
     51      REAL, SAVE, ALLOCATABLE :: d_u_lif(:,:), d_v_lif(:,:)
     52      !$OMP THREADPRIVATE(d_u_lif, d_v_lif)
    3253! tendance du a la conersion Ec -> E thermique
    33       REAL, ALLOCATABLE :: d_t_ec(:,:)
    34       REAL, ALLOCATABLE :: d_ts(:,:), d_tr(:,:,:)
     54      REAL, SAVE, ALLOCATABLE :: d_t_ec(:,:)
     55      !$OMP THREADPRIVATE(d_t_ec)
     56      REAL, SAVE, ALLOCATABLE :: d_ts(:,:), d_tr(:,:,:)
     57      !$OMP THREADPRIVATE(d_ts, d_tr)
    3558CONTAINS
    3659

  • LMDZ4/trunk/libf/phylmd/physiq.F

    r979 r987  
    111111      integer iflag_radia     ! active ou non le rayonnement (MPL)
    112112      save iflag_radia
     113c$OMP THREADPRIVATE(iflag_radia)
    113114c======================================================================
    114115      LOGICAL check ! Verifier la conservation du modele en eau
    … …  
    118119c======================================================================
    119120      LOGICAL, SAVE :: rnpb=.TRUE.
     121c$OMP THREADPRIVATE(rnpb)
    120122cIM "slab" ocean
    121123      REAL tslab(klon)    !Temperature du slab-ocean
    … …  
    247249     .15000., 10000., 7000., 5000., 3000., 2000., 1000./
    248250      SAVE rlevstd
     251c$OMP THREADPRIVATE(rlevstd)
    249252      CHARACTER*4 clevSTD(nlevSTD)
    250253      DATA clevSTD/'1000','925 ','850 ','700 ','600 ',
    … …  
    252255     .'70  ','50  ','30  ','20  ','10  '/
    253256      SAVE clevSTD
     257c$OMP THREADPRIVATE(clevSTD)
    254258c
    255259      CHARACTER*4 bb2
    … …  
    353357c      INTEGER ncol(napisccp), ncolmx, seed(klon,napisccp)
    354358      INTEGER,SAVE :: ncol(napisccp)
     359c$OMP THREADPRIVATE(ncol)
    355360      INTEGER ncolmx, seed(klon,napisccp)
    356361      REAL nbsunlit(nregISCtot,klon,napisccp)  !nbsunlit : moyenne de sunlit
    … …  
    554559      REAL qsol(klon)
    555560      REAL,save ::  solarlong0
     561c$OMP THREADPRIVATE(solarlong0)
     562
    556563c
    557564c  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
    … …  
    587594      INTEGER it_wape_prescr
    588595      SAVE wape_prescr, fip_prescr, it_wape_prescr
     596c$OMP THREADPRIVATE(wape_prescr, fip_prescr, it_wape_prescr)
    589597c
    590598c variables supplementaires de concvl
    … …  
    600608
    601609c$OMP THREADPRIVATE(alp_bl_prescr,ale_bl_prescr)
     610c$OMP THREADPRIVATE(ale_max,alp_max)
    602611
    603612      real ale_wake(klon)
    … …  
    879888      real ratqsbas,ratqshaut
    880889      save ratqsbas,ratqshaut
     890c$OMP THREADPRIVATE(ratqsbas,ratqshaut)
    881891      real zpt_conv(klon,klev)
    882892
    … …  
    15051515c#endif
    15061516
     1517c$OMP MASTER
    15071518       call phys_output_open(jjmp1,nqmax,nlevSTD,clevSTD,nbteta,
    15081519     &                        ctetaSTD,dtime,presnivs,ok_veget,
    15091520     &                        ocean,iflag_pbl,ok_mensuel,ok_journe,
    15101521     &                        ok_hf,ok_instan,nid_files)
     1522c$OMP END MASTER
     1523c$OMP BARRIER
    15111524
    15121525#ifdef histISCCP

  • LMDZ4/trunk/libf/phylmd/surf_land_orchidee_mod.F90

    r888 r987  
    1818  USE comgeomphy,   ONLY : cuphy, cvphy
    1919  USE mod_grid_phy_lmdz
    20   USE mod_phys_lmdz_para
     20  USE mod_phys_lmdz_para, mpi_root_rank=>mpi_root
    2121
    2222  IMPLICIT NONE
    … …  
    2525  PUBLIC  :: surf_land_orchidee
    2626
     27  LOGICAL, ALLOCATABLE, SAVE :: flag_omp(:)
    2728CONTAINS
    2829!
    … …  
    3940       tsol_rad, tsurf_new, alb1_new, alb2_new, &
    4041       emis_new, z0_new, qsurf)
     42   USE mod_surf_para
     43   USE mod_synchro_omp
     44   
    4145!   
    4246! Cette routine sert d'interface entre le modele atmospherique et le
    … …  
    163167
    164168    REAL, DIMENSION(knon,2)                   :: albedo_out
    165     !$OMP THREADPRIVATE(albedo_out)
    166169
    167170! Pb de nomenclature
    … …  
    188191    REAL, ALLOCATABLE, DIMENSION(:), SAVE     :: riverflow
    189192    !$OMP THREADPRIVATE(riverflow)
     193   
     194    INTEGER :: orch_omp_rank
     195    INTEGER :: orch_omp_size
    190196!
    191197! Fin definition
    … …  
    198204 
    199205    IF (debut) THEN
     206       CALL Init_surf_para(knon)
    200207       ALLOCATE(ktindex(knon))
    201208       IF ( .NOT. ALLOCATED(albedo_keep)) THEN
    202           ALLOCATE(albedo_keep(klon))
     209!ym          ALLOCATE(albedo_keep(klon))
     210!ym bizarre que non alloué en knon precedement
     211          ALLOCATE(albedo_keep(knon))
    203212          ALLOCATE(zlev(knon))
    204213       ENDIF
    … …  
    333342    IF (lafin) lrestart_write = .TRUE.
    334343    IF (check) WRITE(lunout,*)'lafin ',lafin,lrestart_write
    335    
     344     
    336345    petA_orc(1:knon) = petBcoef(1:knon) * dtime
    337346    petB_orc(1:knon) = petAcoef(1:knon)
    … …  
    352361!  write(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
    353362
    354 !
    355 ! Init Orchidee
    356 !
    357 !  if (pole_nord) then
    358 !    offset=0
    359 !    ktindex(:)=ktindex(:)+iim-1
    360 !  else
    361 !    offset = klon_mpi_begin-1+iim-1
    362 !    ktindex(:)=ktindex(:)+MOD(offset,iim)
    363 !    offset=offset-MOD(offset,iim)
    364 !  endif
    365363 
    366364    IF (debut) THEN
    367        CALL Get_orchidee_communicator(knon,orch_comm)
    368        IF (knon /=0) THEN
    369           CALL Init_orchidee_index(knon,orch_comm,knindex,offset,ktindex)
    370 
    371 #ifndef CPP_PARA
    372 #define ORC_PREPAR
    373 #endif
    374 #ifdef ORC_PREPAR
    375           ! Interface for ORCHIDEE version 1.9 or earlier compiled in sequential mode(without preprocessing flag CPP_PARA)
     365       CALL Init_orchidee_index(knon,knindex,offset,ktindex)
     366       CALL Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
     367       CALL Init_synchro_omp
     368       
     369       IF (knon_mpi > 0) THEN
     370         CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm)
     371       ENDIF
     372
     373       
     374       IF (knon > 0) THEN
     375
    376376          CALL intersurf_main (itime+itau_phy-1, iim, jjm+1, knon, ktindex, dtime, &
    377377               lrestart_read, lrestart_write, lalo, &
    … …  
    383383               tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
    384384               lon_scat, lat_scat)
    385 
    386 #else         
    387           ! Interface for ORCHIDEE version 1.9 compiled in parallel mode(with preprocessing flag CPP_PARA)
    388           CALL intersurf_main (itime+itau_phy-1, iim, jjm+1, offset, knon, ktindex, &
    389                orch_comm, dtime, lrestart_read, lrestart_write, lalo, &
    390                contfrac, neighbours, resolution, date0, &
    391                zlev,  u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
    392                cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
    393                precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown(1:knon), ps(1:knon), &
    394                evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
    395                tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
    396                lon_scat, lat_scat)
    397 #endif
    398          
    399        ENDIF
     385         
     386       ENDIF
     387
     388       CALL Synchro_omp
    400389
    401390       albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
    … …  
    403392    ENDIF
    404393
     394   
    405395!  swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
    406396    swdown_vrai(1:knon) = swdown(1:knon)
    407397
    408     IF (knon /=0) THEN
    409    
    410 #ifdef ORC_PREPAR
    411        ! Interface for ORCHIDEE version 1.9 or earlier compiled in sequential mode(without preprocessing flag CPP_PARA)
    412        CALL intersurf_main (itime+itau_phy, iim, jjm+1, knon, ktindex, dtime, &
     398    IF (knon > 0) THEN
     399   
     400       CALL intersurf_main (itime+itau_phy, iim, jjm+1, knon, ktindex, dtime,  &
    413401            lrestart_read, lrestart_write, lalo, &
    414             contfrac, neighbours, resolution, date0, &
    415             zlev,  u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
    416             cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
    417             precip_rain, precip_snow, lwdown, swnet, swdown_vrai, ps, &
    418             evap, fluxsens, fluxlat, coastalflow, riverflow, &
    419             tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
    420             lon_scat, lat_scat)
    421        
    422 #else
    423        ! Interface for ORCHIDEE version 1.9 compiled in parallel mode(with preprocessing flag CPP_PARA)
    424        CALL intersurf_main (itime+itau_phy, iim, jjm+1,offset, knon, ktindex, &
    425             orch_comm,dtime, lrestart_read, lrestart_write, lalo, &
    426402            contfrac, neighbours, resolution, date0, &
    427403            zlev,  u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
    … …  
    431407            tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
    432408            lon_scat, lat_scat)
    433 #endif
    434409       
    435410    ENDIF
    436411
     412    CALL Synchro_omp
     413   
    437414    albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
    438415
    … …  
    455432    IF (debut) lrestart_read = .FALSE.
    456433   
     434    IF (debut) CALL Finalize_surf_para
     435   
    457436  END SUBROUTINE surf_land_orchidee
    458437!
    459438!****************************************************************************************
    460439!
    461   SUBROUTINE Init_orchidee_index(knon,orch_comm,knindex,offset,ktindex)
    462    
    463     INCLUDE "dimensions.h"
    464 
     440  SUBROUTINE Init_orchidee_index(knon,knindex,offset,ktindex)
     441  USE mod_surf_para
     442  USE mod_grid_phy_lmdz
     443 
     444    INTEGER,INTENT(IN)    :: knon
     445    INTEGER,INTENT(IN)    :: knindex(klon)   
     446    INTEGER,INTENT(OUT)   :: offset
     447    INTEGER,INTENT(OUT)   :: ktindex(klon)
     448   
     449    INTEGER               :: ktindex_glo(knon_glo)
     450    INTEGER               :: offset_para(0:omp_size*mpi_size-1)
     451    INTEGER               :: LastPoint
     452    INTEGER               :: task
     453   
     454    ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
     455   
     456    CALL gather_surf(ktindex(1:knon),ktindex_glo)
     457   
     458    IF (is_mpi_root .AND. is_omp_root) THEN
     459      LastPoint=0
     460      DO Task=0,mpi_size*omp_size-1
     461        IF (knon_glo_para(Task)>0) THEN
     462           offset_para(task)= LastPoint-MOD(LastPoint,nbp_lon)
     463           LastPoint=ktindex_glo(knon_glo_end_para(task))
     464        ENDIF
     465      ENDDO
     466    ENDIF
     467   
     468    CALL bcast(offset_para)
     469   
     470    offset=offset_para(omp_size*mpi_rank+omp_rank)
     471   
     472    ktindex(1:knon)=ktindex(1:knon)-offset
     473
     474  END SUBROUTINE Init_orchidee_index
     475
     476!
     477!************************* ***************************************************************
     478!
     479
     480  SUBROUTINE Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
     481  USE  mod_surf_para
     482     
    465483#ifdef CPP_PARA
    466484    INCLUDE 'mpif.h'
    467485#endif   
    468486
    469 
    470 ! Input arguments
    471 !****************************************************************************************
    472     INTEGER, INTENT(IN)                   :: knon
    473     INTEGER, INTENT(IN)                   :: orch_comm
    474     INTEGER, DIMENSION(klon), INTENT(IN)  :: knindex
    475 
    476 ! Output arguments
    477 !****************************************************************************************
    478     INTEGER, INTENT(OUT)                  :: offset
    479     INTEGER, DIMENSION(knon), INTENT(OUT) :: ktindex
    480 
    481 ! Local varables
    482 !****************************************************************************************
    483 #ifdef CPP_PARA
    484     INTEGER, DIMENSION(MPI_STATUS_SIZE)   :: status
     487    INTEGER,INTENT(OUT) :: orch_comm
     488    INTEGER,INTENT(OUT) :: orch_omp_size
     489    INTEGER,INTENT(OUT) :: orch_omp_rank
     490    INTEGER             :: color
     491    INTEGER             :: i,ierr
     492!
     493! End definition
     494!****************************************************************************************
     495   
     496   
     497    IF (is_omp_root) THEN         
     498     
     499      IF (knon_mpi==0) THEN
     500         color = 0
     501      ELSE
     502         color = 1
     503      ENDIF
     504   
     505#ifdef CPP_PARA   
     506      CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
    485507#endif
    486508
    487     INTEGER                               :: MyLastPoint
    488     INTEGER                               :: LastPoint
    489     INTEGER                               :: mpi_rank_orch
    490     INTEGER                               :: mpi_size_orch
    491     INTEGER                               :: ierr
    492 !
    493 ! End definition
    494 !****************************************************************************************
    495 
    496     MyLastPoint=klon_mpi_begin-1+knindex(knon)+iim-1
    497    
    498     IF (is_parallel) THEN
    499 #ifdef CPP_PARA   
    500        CALL MPI_COMM_SIZE(orch_comm,mpi_size_orch,ierr)
    501        CALL MPI_COMM_RANK(orch_comm,mpi_rank_orch,ierr)
    502 #endif
    503     ELSE
    504        mpi_rank_orch=0
    505        mpi_size_orch=1
    506     ENDIF
    507 
    508     IF (is_parallel) THEN
    509        IF (mpi_rank_orch /= 0) THEN
    510 #ifdef CPP_PARA
    511           CALL MPI_RECV(LastPoint,1,MPI_INTEGER,mpi_rank_orch-1,1234,orch_comm,status,ierr)
    512 #endif
    513        ENDIF
    514        
    515        IF (mpi_rank_orch /= mpi_size_orch-1) THEN
    516 #ifdef CPP_PARA
    517           CALL MPI_SEND(MyLastPoint,1,MPI_INTEGER,mpi_rank_orch+1,1234,orch_comm,ierr) 
    518 #endif
    519        ENDIF
    520     ENDIF
    521    
    522     IF (mpi_rank_orch == 0) THEN
    523        offset=0
    524     ELSE
    525        offset=LastPoint-MOD(LastPoint,iim)
    526     ENDIF
    527    
    528     ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin+iim-1)-offset-1     
    529    
    530 
    531   END SUBROUTINE  Init_orchidee_index
    532 !
    533 !****************************************************************************************
    534 !
    535   SUBROUTINE Get_orchidee_communicator(knon,orch_comm)
    536    
     509   ENDIF
     510   
     511   IF (knon_mpi /= 0) THEN
     512     orch_omp_size=0
     513     DO i=0,omp_size-1
     514       IF (knon_omp_para(i) /=0) THEN
     515         orch_omp_size=orch_omp_size+1
     516         IF (i==omp_rank) orch_omp_rank=orch_omp_size-1
     517       ENDIF
     518     ENDDO
     519   ENDIF
     520       
     521   
     522  END SUBROUTINE Get_orchidee_communicator
     523!
     524!****************************************************************************************
     525! 
     526
     527  SUBROUTINE Init_neighbours(knon,neighbours,knindex,pctsrf)
     528    USE mod_grid_phy_lmdz
     529    USE mod_surf_para   
     530    INCLUDE "indicesol.h"
     531
    537532#ifdef CPP_PARA
    538533    INCLUDE 'mpif.h'
    539534#endif   
    540535
    541 
    542     INTEGER,INTENT(IN)  :: knon
    543     INTEGER,INTENT(OUT) :: orch_comm
    544    
    545     INTEGER             :: color
    546     INTEGER             :: ierr
    547 !
    548 ! End definition
    549 !****************************************************************************************
    550 
    551     IF (knon==0) THEN
    552        color = 0
    553     ELSE
    554        color = 1
    555     ENDIF
    556    
    557 #ifdef CPP_PARA   
    558     CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
    559 #endif
    560    
    561   END SUBROUTINE Get_orchidee_communicator
    562 !
    563 !****************************************************************************************
    564 ! 
    565   SUBROUTINE Init_neighbours(knon,neighbours,ktindex,pctsrf)
    566    
    567     INCLUDE "indicesol.h"
    568     INCLUDE "dimensions.h"
    569 #ifdef CPP_PARA
    570     INCLUDE 'mpif.h'
    571 #endif   
    572 
    573536! Input arguments
    574537!****************************************************************************************
    575538    INTEGER, INTENT(IN)                     :: knon
    576     INTEGER, DIMENSION(klon), INTENT(IN)    :: ktindex
     539    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
    577540    REAL, DIMENSION(klon), INTENT(IN)       :: pctsrf
    578541   
    … …  
    583546! Local variables
    584547!****************************************************************************************
    585     INTEGER                              :: knon_g
    586548    INTEGER                              :: i, igrid, jj, ij, iglob
    587549    INTEGER                              :: ierr, ireal, index
    588     INTEGER, DIMENSION(0:mpi_size-1)     :: knon_nb
    589     INTEGER, DIMENSION(0:mpi_size-1)     :: displs
    590550    INTEGER, DIMENSION(8,3)              :: off_ini
    591551    INTEGER, DIMENSION(8)                :: offset 
    592     INTEGER, DIMENSION(knon)             :: ktindex_p
    593     INTEGER, DIMENSION(iim,jjm+1)        :: correspond
    594     INTEGER, ALLOCATABLE, DIMENSION(:)   :: ktindex_g
    595     INTEGER, ALLOCATABLE, DIMENSION(:,:) :: neighbours_g
    596     REAL, DIMENSION(klon_glo)            :: pctsrf_g
    597    
     552    INTEGER, DIMENSION(nbp_lon,nbp_lat)  :: correspond
     553    INTEGER, DIMENSION(knon_glo)         :: ktindex_glo
     554    INTEGER, DIMENSION(knon_glo,8)       :: neighbours_glo
     555    REAL, DIMENSION(klon_glo)            :: pctsrf_glo
     556    INTEGER                              :: ktindex(klon)
    598557!
    599558! End definition
    600559!****************************************************************************************
    601560
    602     IF (is_sequential) THEN
    603        knon_nb(:)=knon
    604     ELSE 
    605        
    606 #ifdef CPP_PARA 
    607        CALL MPI_GATHER(knon,1,MPI_INTEGER,knon_nb,1,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
    608 #endif
    609        
    610     ENDIF
    611    
    612     IF (is_mpi_root) THEN
    613        knon_g=SUM(knon_nb(:))
    614        ALLOCATE(ktindex_g(knon_g))
    615        ALLOCATE(neighbours_g(knon_g,8))
    616        neighbours_g(:,:)=-1
    617        displs(0)=0
    618        DO i=1,mpi_size-1
    619           displs(i)=displs(i-1)+knon_nb(i-1)
    620        ENDDO
    621     ENDIF
    622    
    623     ktindex_p(1:knon)=ktindex(1:knon)+klon_mpi_begin-1+iim-1
    624    
    625     IF (is_sequential) THEN
    626        ktindex_g(:)=ktindex_p(:)
    627     ELSE
    628        
    629 #ifdef CPP_PARA 
    630        CALL MPI_GATHERV(ktindex_p,knon,MPI_INTEGER,ktindex_g,knon_nb,&
    631             displs,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
    632 #endif
    633        
    634     ENDIF
    635    
    636     CALL Gather(pctsrf,pctsrf_g)
    637    
    638     IF (is_mpi_root) THEN
     561    ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
     562   
     563    CALL gather_surf(ktindex(1:knon),ktindex_glo)
     564    CALL gather(pctsrf,pctsrf_glo)
     565   
     566    IF (is_mpi_root .AND. is_omp_root) THEN
     567      neighbours_glo(:,:)=-1
    639568!  Initialisation des offset   
    640569!
    641570! offset bord ouest
    642        off_ini(1,1) = - iim  ; off_ini(2,1) = - iim + 1; off_ini(3,1) = 1
    643        off_ini(4,1) = iim + 1; off_ini(5,1) = iim      ; off_ini(6,1) = 2 * iim - 1
    644        off_ini(7,1) = iim -1 ; off_ini(8,1) = - 1
     571       off_ini(1,1) = - nbp_lon   ; off_ini(2,1) = - nbp_lon + 1     ; off_ini(3,1) = 1
     572       off_ini(4,1) = nbp_lon + 1 ; off_ini(5,1) = nbp_lon           ; off_ini(6,1) = 2 * nbp_lon - 1
     573       off_ini(7,1) = nbp_lon -1  ; off_ini(8,1) = - 1
    645574! offset point normal
    646        off_ini(1,2) = - iim  ; off_ini(2,2) = - iim + 1; off_ini(3,2) = 1
    647        off_ini(4,2) = iim + 1; off_ini(5,2) = iim      ; off_ini(6,2) = iim - 1
    648        off_ini(7,2) = -1     ; off_ini(8,2) = - iim - 1
     575       off_ini(1,2) = - nbp_lon   ; off_ini(2,2) = - nbp_lon + 1     ; off_ini(3,2) = 1
     576       off_ini(4,2) = nbp_lon + 1 ; off_ini(5,2) = nbp_lon           ; off_ini(6,2) = nbp_lon - 1
     577       off_ini(7,2) = -1          ; off_ini(8,2) = - nbp_lon - 1
    649578! offset bord   est
    650        off_ini(1,3) = - iim; off_ini(2,3) = - 2 * iim + 1; off_ini(3,3) = - iim + 1
    651        off_ini(4,3) =  1   ; off_ini(5,3) = iim          ; off_ini(6,3) = iim - 1
    652        off_ini(7,3) = -1   ; off_ini(8,3) = - iim - 1
     579       off_ini(1,3) = - nbp_lon   ; off_ini(2,3) = - 2 * nbp_lon + 1 ; off_ini(3,3) = - nbp_lon + 1
     580       off_ini(4,3) =  1          ; off_ini(5,3) = nbp_lon           ; off_ini(6,3) = nbp_lon - 1
     581       off_ini(7,3) = -1          ; off_ini(8,3) = - nbp_lon - 1
    653582!
    654583!
    655584! Attention aux poles
    656585!
    657        DO igrid = 1, knon_g
    658           index = ktindex_g(igrid)
    659           jj = INT((index - 1)/iim) + 1
    660           ij = index - (jj - 1) * iim
     586       DO igrid = 1, knon_glo
     587          index = ktindex_glo(igrid)
     588          jj = INT((index - 1)/nbp_lon) + 1
     589          ij = index - (jj - 1) * nbp_lon
    661590          correspond(ij,jj) = igrid
    662591       ENDDO
    663592       
    664        DO igrid = 1, knon_g
    665           iglob = ktindex_g(igrid)
    666           IF (MOD(iglob, iim) == 1) THEN
     593       DO igrid = 1, knon_glo
     594          iglob = ktindex_glo(igrid)
     595         
     596          IF (MOD(iglob, nbp_lon) == 1) THEN
    667597             offset = off_ini(:,1)
    668           ELSE IF(MOD(iglob, iim) == 0) THEN
     598          ELSE IF(MOD(iglob, nbp_lon) == 0) THEN
    669599             offset = off_ini(:,3)
    670600          ELSE
    671601             offset = off_ini(:,2)
    672602          ENDIF
     603         
    673604          DO i = 1, 8
    674605             index = iglob + offset(i)
    675              ireal = (MIN(MAX(1, index - iim + 1), klon_glo))
    676              IF (pctsrf_g(ireal) > EPSFRA) THEN
    677                 jj = INT((index - 1)/iim) + 1
    678                 ij = index - (jj - 1) * iim
    679                 neighbours_g(igrid, i) = correspond(ij, jj)
     606             ireal = (MIN(MAX(1, index - nbp_lon + 1), klon_glo))
     607             IF (pctsrf_glo(ireal) > EPSFRA) THEN
     608                jj = INT((index - 1)/nbp_lon) + 1
     609                ij = index - (jj - 1) * nbp_lon
     610                neighbours_glo(igrid, i) = correspond(ij, jj)
    680611             ENDIF
    681612          ENDDO
    … …  
    684615    ENDIF
    685616   
    686     DO i=1,8
    687        IF (is_sequential) THEN
    688           neighbours(:,i)=neighbours_g(:,i)
    689        ELSE
    690 #ifdef CPP_PARA
    691           CALL MPI_SCATTERV(neighbours_g(:,i),knon_nb,displs,MPI_INTEGER,neighbours(:,i),knon,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
     617    DO i = 1, 8
     618      CALL scatter_surf(neighbours_glo(:,i),neighbours(1:knon,i))
     619    ENDDO
     620  END SUBROUTINE Init_neighbours
     621
     622!
     623!****************************************************************************************
     624!
     625
    692626#endif
    693        ENDIF
    694     ENDDO
    695    
    696   END SUBROUTINE Init_neighbours
    697 !
    698 !****************************************************************************************
    699 !
    700 
    701 #endif
    702627
    703628END MODULE surf_land_orchidee_mod

  • LMDZ4/trunk/libf/phylmd/thermcell.F

    r940 r987  
    5252      save idetr
    5353      data idetr/3/
    54 
     54c$OMP THREADPRIVATE(idetr)
    5555c   local:
    5656c   ------
    … …  
    9494      data isplit/0/
    9595      save isplit
     96c$OMP THREADPRIVATE(isplit)
    9697
    9798      logical sorties
    … …  
    125126      data first /.false./
    126127      save first
     128c$OMP THREADPRIVATE(first)
    127129cRC
    128130
    … …  
    137139      save ncorrec
    138140      data ncorrec/0/
     141c$OMP THREADPRIVATE(ncorrec)
    139142     
    140143c
    … …  
    11311134c$OMP THREADPRIVATE(zmax0_sec)
    11321135      logical, save :: first = .true.
     1136c$OMP THREADPRIVATE(first)
    11331137
    11341138      if (first) then

  • LMDZ4/trunk/libf/phylmd/thermcell.h

    r972 r987  
    88      common/ctherm3/w2di_thermals
    99      common/ctherm4/iflag_coupl,iflag_clos,iflag_wake
     10!$OMP THREADPRIVATE(/ctherm1/,/ctherm2/,/ctherm3/,/ctherm4/)

  • LMDZ4/trunk/libf/phylmd/thermcell_flux.F90

    r938 r987  
    4949      REAL fomass_max,alphamax
    5050      save fomass_max,alphamax
     51!$OMP THREADPRIVATE(fomass_max,alphamax)
    5152
    5253      fomass_max=0.5

  • LMDZ4/trunk/libf/phylmd/thermcell_flux2.F90

    r972 r987  
    4545      REAL fomass_max,alphamax
    4646      save fomass_max,alphamax
     47!$OMP THREADPRIVATE(fomass_max,alphamax)
    4748
    4849      fomass_max=0.5

  • LMDZ4/trunk/libf/phylmd/thermcell_main.F90

    r972 r987  
    6969      data icount/0/
    7070      save icount
     71!$OMP THREADPRIVATE(icount)
    7172
    7273      integer,save :: igout=1
     74!$OMP THREADPRIVATE(igout)
    7375      integer,save :: lunout1=6
     76!$OMP THREADPRIVATE(lunout1)
    7477      integer,save :: lev_out=10
     78!$OMP THREADPRIVATE(lev_out)
    7579
    7680      INTEGER ig,k,l,ll
    … …  
    118122      data isplit/0/
    119123      save isplit
     124!$OMP THREADPRIVATE(isplit)
    120125
    121126      logical sorties

  • LMDZ4/trunk/libf/phylmd/thermcell_old.F

    r940 r987  
    5353      save idetr
    5454      data idetr/3/
     55c$OMP THREADPRIVATE(idetr)
    5556
    5657c   local:
    … …  
    8889      data isplit/0/
    8990      save isplit
     91c$OMP THREADPRIVATE(isplit)
    9092
    9193      logical sorties
    … …  
    117119      save ncorrec
    118120      data ncorrec/0/
     121c$OMP THREADPRIVATE(ncorrec)
     122
    119123c
    120124c-----------------------------------------------------------------------
    … …  
    852856      save idetr
    853857      data idetr/3/
     858c$OMP THREADPRIVATE(idetr)
    854859
    855860c   local:
    … …  
    865870      save alpha
    866871      data alpha/1./
     872c$OMP THREADPRIVATE(alpha)
     873
    867874c RC
    868875      real zmax(klon),zw,zz,zw2(klon,klev+1),ztva(klon,klev),zzz
    … …  
    918925      data isplit/0/
    919926      save isplit
     927c$OMP THREADPRIVATE(isplit)
    920928
    921929      logical sorties
    … …  
    977985      real zlevinter(klon)
    978986      logical, save :: first = .true.
     987c$OMP THREADPRIVATE(first)
    979988c      data first /.false./
    980989c      save first
    … …  
    10001009      save ncorrec
    10011010      data ncorrec/0/
     1011c$OMP THREADPRIVATE(ncorrec)
     1012
    10021013c
    10031014
    … …  
    26482659      save idetr
    26492660      data idetr/3/
     2661c$OMP THREADPRIVATE(idetr)
    26502662
    26512663c   local:
    … …  
    26922704      data isplit/0/
    26932705      save isplit
     2706c$OMP THREADPRIVATE(isplit)
    26942707
    26952708      logical sorties
    … …  
    27272740      data first /.false./
    27282741      save first
     2742c$OMP THREADPRIVATE(first)
     2743
    27292744cRC
    27302745
    … …  
    27402755      save ncorrec
    27412756      data ncorrec/0/
     2757c$OMP THREADPRIVATE(ncorrec)
     2758
    27422759c
    27432760
    … …  
    37553772      save idetr
    37563773      data idetr/3/
     3774c$OMP THREADPRIVATE(idetr)
    37573775
    37583776c   local:
    … …  
    37963814      data isplit/0/
    37973815      save isplit
     3816c$OMP THREADPRIVATE(isplit)
    37983817
    37993818      logical sorties
    … …  
    38233842      data first /.false./
    38243843      save first
     3844c$OMP THREADPRIVATE(first)
    38253845cRC
    38263846
    … …  
    38353855      save ncorrec
    38363856      data ncorrec/0/
     3857c$OMP THREADPRIVATE(ncorrec)
    38373858     
    38383859c
    … …  
    51605181      save idetr
    51615182      data idetr/3/
     5183c$OMP THREADPRIVATE(idetr)
    51625184
    51635185c   local:
    … …  
    52015223      data isplit/0/
    52025224      save isplit
     5225c$OMP THREADPRIVATE(isplit)
    52035226
    52045227      logical sorties
    … …  
    52285251      data first /.false./
    52295252      save first
     5253c$OMP THREADPRIVATE(first)
    52305254cRC
    52315255
    … …  
    52405264      save ncorrec
    52415265      data ncorrec/0/
     5266c$OMP THREADPRIVATE(ncorrec)
    52425267     
    52435268c

  • LMDZ4/trunk/libf/phylmd/yamada.F

    r776 r987  
    5555      save first
    5656      data first/.true./
    57 
     57c$OMP THREADPRIVATE(first)
    5858
    5959      integer ig,k
    … …  
    7171      save ric,rifc,b1,kap
    7272      data ric,rifc,b1,kap/0.195,0.191,16.6,0.3/
     73c$OMP THREADPRIVATE(ric,rifc,b1,kap)
    7374
    7475      real frif,falpha,fsm
Note: See TracChangeset for help on using the changeset viewer.