Changeset 1300 for trunk/LMDZ.COMMON


Ignore:
Timestamp:
Jun 25, 2014, 1:19:59 PM (10 years ago)
Author:
emillour
Message:

Common dynamics:
Some updates to keep up with LMDZ5 Earth model evolution (up to LMDZ5 rev 1955).
Main change is the introduction of a "dyn3d_common" directory
to store files common to dyn3d and dyn3dpar.
See file "DOC/chantiers/commit_importants.log" for detailed list
of changes. These changes do not change results on test cases.
EM

Location:
trunk/LMDZ.COMMON
Files:
1 added
137 deleted
15 edited
129 moved

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.COMMON/bld.cfg

    r1107 r1300  
    2626src::dyn     %SRC_PATH/%DYN
    2727src::phys    %SRC_PATH/%PHYS
     28#src::sisvat  %SRC_PATH/%PHYS/sisvat
    2829src::grid    %SRC_PATH/grid
    2930src::filtrez %SRC_PATH/filtrez
    3031src::bibio   %SRC_PATH/bibio
     32src::dyn3d_common   %SRC_PATH/dyn3d_common
    3133src::cosp    %COSP
    3234src::chem    %CHEM
    … …  
    8688bld::excl_dep        use::mod_prism_get_proto
    8789bld::excl_dep        use::mod_prism_put_proto
     90bld::excl_dep        use::xios
     91bld::excl_dep        use::iaxis
     92bld::excl_dep        use::iaxis_attr
     93bld::excl_dep        use::icontext_attr
     94bld::excl_dep        use::idate
     95bld::excl_dep        use::idomain_attr
     96bld::excl_dep        use::ifield_attr
     97bld::excl_dep        use::ifile_attr
     98bld::excl_dep        use::ixml_tree
    8899
    89100# Don't generate interface files

  • trunk/LMDZ.COMMON/create_make_gcm

    r1107 r1300  
    4242echo 'LIBF    = $(GCM)/libf'
    4343if [ "$CRAY" = '0' ] ; then
    44 #   echo 'LIBO    = $(GCM)/libo/$(MACHINE)'
    4544   echo 'LIBO    = $(LIBOGCM)/$(MACHINE)'
    4645else
    4746   echo 'LIBO    = $(GCM)/libo'
    4847fi
    49 #echo 'LOCAL_DIR=$(GCM)'
    50 #echo $localdir
    5148echo "LOCAL_DIR=`echo $localdir`"
    5249echo 'BIBIO    = $(LIBF)/bibio'
     50echo 'DYN3D_COMMON   = $(LIBF)/dyn3d_common'
    5351echo "FILTRE   = filtre"
    5452echo "PHYS  = "
    … …  
    7068echo 'L_PHY = -lphy$(PHYS) '
    7169echo 'L_BIBIO    = -lbibio'
     70echo 'L_DYN3D_COMMON    = -ldyn3d_common'
    7271echo 'L_ADJNT    ='
    7372echo 'L_COSP     = -lcosp'
    … …  
    103102echo
    104103#echo 'main : chimie $(DYN) bibio phys $(OPTION_DEP) '
    105 echo 'main : bibio $(DYN) phys $(OPTION_DEP) '
     104echo 'main : $(DYN) bibio dyn3d_common phys $(OPTION_DEP) '
    106105echo '  cd $(LIBO) ; $(RANLIB) lib*.a ; cd $(GCM) ;\'
    107106echo '  cd $(LOCAL_DIR); \'
    108107echo '  $(COMPILE90) $(LIBF)/$(DIRMAIN)/$(SOURCE) -o $(PROG).o ; \'
    109 echo '  $(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_COSP) $(L_AERONOMARS) $(L_FILTRE) $(L_PHY) $(L_DYN) $(L_BIBIO) $(L_DYN) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
     108echo '  $(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_COSP) $(L_AERONOMARS) $(L_PHY) $(L_DYN) $(L_DYN3D_COMMON) $(L_BIBIO) $(L_DYN3D_COMMON) $(L_PHY) $(L_DYN) $(L_FILTRE) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
    110109echo
    111110echo 'dyn : $(LIBO)/libdyn$(DIM)d$(FLAG_PARA).a $(FILTRE)$(DIM)d'
    … …  
    116115echo
    117116echo 'bibio : $(LIBO)/libbibio.a'
     117echo
     118echo 'dyn3d_common : $(LIBO)/libdyn3d_common.a'
    118119echo
    119120echo 'adjnt : $(LIBO)/libadjnt.a'
    … …  
    212213            strj=`echo $stri | tr [A-Z] [a-z]`
    213214            str2=""
    214             for dirinc in filtrez bibio grid dyn3d $diri $diri/*/ ; do
     215            for dirinc in filtrez bibio dyn3d_common grid dyn3d phydev $diri $diri/*/ ; do
    215216# Recherche dans l'ordre hierarchique inverse car seule la derniere
    216217# ligne est conservee
     218               if [ $dirinc = phydev ] ; then
     219                   dirstr='$(PHYS)'
     220                   libstr='phy$(PHYS)'
     221               else
     222                   dirstr=$dirinc
     223                   libstr=$dirinc
     224               fi
    217225               if [ -f $dirinc/$stri ] ; then
    218                   str2='$(LIBF)/'$dirinc/$stri
     226                  str2='$(LIBF)/'$dirstr/$stri
    219227               elif [ -f $dirinc/$strj ] ; then
    220                   str2='$(LIBF)/'$dirinc/$stri
     228                  str2='$(LIBF)/'$dirstr/$stri
    221229               elif [ -f $dirinc/$strj.F90 ]  || [ -f $dirinc/$strj.F ]  ; then
    222                   strlib=`echo $dirinc | awk -F/ ' { print $1 } '`
     230                  strlib=`echo $libstr | awk -F/ ' { print $1 } '`
    223231                  str2='$(LIBO)/lib'$strlib'.a('$strj'.o)'
     232               elif [ -f $dirinc/$stri.F90 ]  || [ -f $dirinc/$stri.F ]  ; then
     233                  strlib=`echo $libstr | awk -F/ ' { print $1 } '`
     234                  str2='$(LIBO)/lib'$strlib'.a('$stri'.o)'
    224235               fi
    225236            done

  • trunk/LMDZ.COMMON/libf/bibio/wxios.F90

    r1019 r1300  
    1818    TYPE(xios_context), SAVE :: g_ctx
    1919!$OMP THREADPRIVATE(g_comm,g_cts_name,g_ctx)
     20    LOGICAL, SAVE :: g_flag_xml = .FALSE.
     21    CHARACTER(len=100) :: g_field_name = "nofield"
     22!$OMP THREADPRIVATE(g_flag_xml,g_field_name)
     23
    2024
    2125    CONTAINS
    … …  
    2529    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2630   
    27     SUBROUTINE concat(str, i, str_i) !MAX i = 99
    28         CHARACTER(len=*), INTENT(IN) :: str
    29         INTEGER, INTENT(IN) :: i
    30         CHARACTER(len=100), INTENT(OUT) :: str_i
    31        
    32        
    33         !INT -> CHAR:
    34         CHARACTER(len=10) :: num
    35         WRITE(num, "(I5)") i
    36         str_i = TRIM(ADJUSTL(str//"_"//TRIM(ADJUSTL(num))))
    37        
     31    SUBROUTINE concat(str, str2, str_str2)
     32        CHARACTER(len=*), INTENT(IN) :: str, str2
     33        CHARACTER(len=20), INTENT(OUT) :: str_str2
     34       
     35       
     36        str_str2 = TRIM(ADJUSTL(str//"_"//TRIM(ADJUSTL(str2))))
     37        !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ",str,"+",str2,"=",str_str2
    3838    END SUBROUTINE concat
    3939   
    … …  
    4747       
    4848        INTEGER :: i = 0
    49        
     49         !!!!!!!!!!!!!!!!!!
     50         ! Pour XIOS:
     51         !  year : y
     52         !  month : mo
     53         !  day : d
     54         !  hour : h
     55         !  minute : mi
     56         !  second : s
     57         !!!!!!!!!!!!!!!!!!
     58
    5059        i = INDEX(odate, "day")
    5160        IF (i > 0) THEN
    5261            ndate = odate(1:i-1)//"d"
    53         ELSE
    54             i = INDEX(odate, "hr")
    55             IF (i > 0) THEN
    56                 ndate = odate(1:i-1)//"h"
    57             ELSE
    58                 ndate = odate
    59             END IF
    60         END IF
    61        
    62         !WRITE(*,*) "Xios. ", odate, " => ", ndate
     62        END IF
     63
     64        i = INDEX(odate, "hr")
     65        IF (i > 0) THEN
     66            ndate = odate(1:i-1)//"h"
     67        END IF
     68
     69        i = INDEX(odate, "mth")
     70        IF (i > 0) THEN
     71            ndate = odate(1:i-1)//"mo"
     72        END IF
     73       
     74        !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", odate, " => ", ndate
    6375    END SUBROUTINE reformadate
    6476   
    … …  
    89101        END IF
    90102       
    91         !WRITE(*,*) "Xios. ", op, " => ", reformaop
     103        !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", op, " => ", reformaop
    92104    END FUNCTION reformaop
    93105
    … …  
    97109    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    98110
    99     SUBROUTINE wxios_init(xios_ctx_name)
     111    SUBROUTINE wxios_init(xios_ctx_name, locom, outcom)
     112        IMPLICIT NONE
     113        INCLUDE 'iniprint.h'
     114
    100115      CHARACTER(len=*), INTENT(IN) :: xios_ctx_name
    101        
    102       INTEGER :: xios_comm
     116      INTEGER, INTENT(IN), OPTIONAL :: locom
     117      INTEGER, INTENT(OUT), OPTIONAL :: outcom
     118
     119   
    103120        TYPE(xios_context) :: xios_ctx
    104      
    105         WRITE(*,*) "Xios. Initialization"
    106 
    107         !Lancement de xios:
    108         CALL xios_initialize(xios_ctx_name, return_comm = xios_comm )
    109        
    110         !Initialisation du contexte:
    111         CALL xios_context_initialize(xios_ctx_name, xios_comm)
    112         CALL xios_get_handle(xios_ctx_name, xios_ctx)    !Récupération
    113         CALL xios_set_current_context(xios_ctx)            !Activation
     121        INTEGER :: xios_comm
     122
     123        IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: Initialization"
     124
     125
     126
     127        IF (PRESENT(locom)) THEN
     128          CALL xios_initialize(xios_ctx_name, local_comm = locom, return_comm = xios_comm )
     129          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," local_comm=",locom,", return_comm=",xios_comm
     130        ELSE
     131          CALL xios_initialize(xios_ctx_name, return_comm = xios_comm )
     132          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," return_comm=",xios_comm
     133        END IF
     134       
     135        IF (PRESENT(outcom)) THEN
     136          outcom = xios_comm
     137          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," outcom=",outcom
     138        END IF
    114139       
    115140        !Enregistrement des variables globales:
    116141        g_comm = xios_comm
    117142        g_ctx_name = xios_ctx_name
     143       
     144        CALL wxios_context_init()
     145       
     146    END SUBROUTINE wxios_init
     147
     148    SUBROUTINE wxios_context_init()
     149        IMPLICIT NONE
     150        INCLUDE 'iniprint.h'
     151
     152        TYPE(xios_context) :: xios_ctx
     153
     154        !Initialisation du contexte:
     155        CALL xios_context_initialize(g_ctx_name, g_comm)
     156        CALL xios_get_handle(g_ctx_name, xios_ctx)    !Récupération
     157        CALL xios_set_current_context(xios_ctx)            !Activation
    118158        g_ctx = xios_ctx
    119        
    120         WRITE(*,*) "Xios. Current context is ", xios_ctx_name
    121     END SUBROUTINE wxios_init
     159
     160        IF (prt_level >= 10) WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
     161
     162        !Une première analyse des héritages:
     163        CALL xios_solve_inheritance()
     164    END SUBROUTINE wxios_context_init
    122165
    123166    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    126169
    127170    SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure)
     171        IMPLICIT NONE
     172        INCLUDE 'iniprint.h'
     173
    128174     !Paramètres:
    129175     CHARACTER(len=*), INTENT(IN) :: calendrier
    … …  
    146192            CASE('earth_360d')
    147193                CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "D360")
    148                 WRITE(*,*) 'Xios. Calendrier terrestre a 360 jours/an'
     194                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 360 jours/an'
    149195            CASE('earth_365d')
    150196                CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "NoLeap")
    151                 WRITE(*,*) 'Xios. Calendrier terrestre a 365 jours/an'
     197                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 365 jours/an'
    152198            CASE('earth_366d')
    153199                CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "Gregorian")
    154                 WRITE(*,*) 'Xios. Calendrier gregorien'
     200                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier gregorien'
    155201            CASE DEFAULT
    156                 abort_message = 'Xios. Mauvais choix de calendrier'
     202                abort_message = 'wxios_set_cal: Mauvais choix de calendrier'
    157203                CALL abort_gcm('Gcm:Xios',abort_message,1)
    158204        END SELECT
    … …  
    161207        WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") annee, mois, jour
    162208       
    163         WRITE(*,*) "Xios. Initial time: ", date
     209        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Initial time: ", date
    164210       
    165211        CALL xios_set_context_attr_hdl(g_ctx, start_date= date)
    … …  
    167213        !Et enfin,le pas de temps:
    168214        CALL xios_set_timestep(mdtime)
    169         WRITE(*,*) "Xios. ts=",mdtime
     215        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: ts=",mdtime
    170216    END SUBROUTINE wxios_set_cal
     217
     218    SUBROUTINE wxios_set_timestep(ts)
     219        REAL, INTENT(IN) :: ts
     220        TYPE(xios_time) :: mdtime     
     221
     222        mdtime = xios_time(0, 0, 0, 0, 0, ts)
     223
     224        CALL xios_set_timestep(mdtime)
     225    END SUBROUTINE wxios_set_timestep
    171226
    172227    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    173228    ! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
    174229    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    175     SUBROUTINE wxios_domain_param(dom_id, is_sequential, iim, jjm, io_lat, io_lon)
     230    SUBROUTINE wxios_domain_param(dom_id, is_sequential, ni, nj, ni_glo, nj_glo,        &
     231                                    ibegin, iend, ii_begin, ii_end, jbegin, jend,       &
     232                                    data_ni, data_ibegin, data_iend,                    &
     233                                    io_lat, io_lon,is_south_pole,mpi_rank)
    176234         
    177         CHARACTER (len=*), INTENT(IN) :: dom_id
    178         LOGICAL, INTENT(IN) :: is_sequential
    179         INTEGER, INTENT(IN) :: iim, jjm
    180         REAL, DIMENSION(:) :: io_lat, io_lon
    181        
     235
     236        IMPLICIT NONE
     237        INCLUDE 'iniprint.h'
     238
     239        CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
     240        LOGICAL,INTENT(IN) :: is_sequential ! flag
     241        INTEGER,INTENT(IN) :: ni ! local MPI domain number of longitudes
     242        INTEGER,INTENT(IN) :: nj ! local MPI domain number of latitudes
     243        INTEGER,INTENT(IN) :: ni_glo ! global grid number of longitudes
     244        INTEGER,INTENT(IN) :: nj_glo ! global grid number of latitudes
     245        INTEGER,INTENT(IN) :: ibegin ! start index, on global grid, of local MPI domain
     246        INTEGER,INTENT(IN) :: iend ! end index, on global grid, of local MPI domain
     247        INTEGER,INTENT(IN) :: ii_begin ! i index at which local data starts (first row)
     248        INTEGER,INTENT(IN) :: ii_end ! i index at which local data ends (last row)
     249        INTEGER,INTENT(IN) :: jbegin ! start index, on global grid, of local MPI domain
     250        INTEGER,INTENT(IN) :: jend ! end index, on global grid, of local MPI domain
     251        INTEGER,INTENT(IN) :: data_ni
     252        INTEGER,INTENT(IN) :: data_ibegin
     253        INTEGER,INTENT(IN) :: data_iend
     254        REAL,INTENT(IN) :: io_lat(:) ! latitudes (of global grid)
     255        REAL,INTENT(IN) :: io_lon(:) ! longitudes (of global grid)
     256        logical,intent(in) :: is_south_pole ! does this process include the south pole?
     257        integer,intent(in) :: mpi_rank ! rank of process
    182258       
    183259        TYPE(xios_domain) :: dom
    184         INTEGER :: ni, nj, ni_glo, nj_glo, ibegin, iend, jbegin, jend
    185         LOGICAl :: boool
    186        
    187         ni_glo = iim
    188         nj_glo = jjm
    189         ni = iim
    190         nj = jjm
    191         ibegin = 1
    192         jbegin = 1
    193         iend = ibegin + ni - 1
    194         jend = jbegin + nj - 1
     260        LOGICAL :: boool
     261       
     262        !Masque pour les problèmes de recouvrement MPI:
     263        LOGICAL :: mask(ni,nj)
    195264       
    196265        !On récupère le handle:
    197266        CALL xios_get_domain_handle(dom_id, dom)
    198267       
    199         WRITE(*,*) "Xios. ni:",iim," ni_glo:", iim, " nj:", jjm, " nj_glo:", jjm
    200         WRITE(*,*) "Xios. Size lon:", SIZE(io_lon), " lat:", SIZE(io_lat)
     268        IF (prt_level >= 10) THEN
     269          WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ni:",ni," ni_glo:", ni_glo, " nj:", nj, " nj_glo:", nj_glo
     270          WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ibegin:",ibegin," iend:", iend, " jbegin:", jbegin, " jend:", jend
     271          WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ii_begin:",ii_begin," ii_end:", ii_end
     272          WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," Size io_lon:", SIZE(io_lon(ibegin:iend)), " io_lat:", SIZE(io_lat(jbegin:jend))
     273        ENDIF
    201274       
    202275        !On parametrise le domaine:
    203         !IF (is_sequential) THEN
    204             CALL xios_set_domain_attr_hdl(dom, ni_glo=iim, ibegin=1, ni=iim,&
    205             & nj_glo=jjm, jbegin=1,nj=jjm,&
    206             & lonvalue=io_lon(ibegin:iend), latvalue=io_lat(jbegin:jend))
    207         !END IF
     276        CALL xios_set_domain_attr_hdl(dom, ni_glo=ni_glo, ibegin=ibegin, ni=ni)
     277        CALL xios_set_domain_attr_hdl(dom, nj_glo=nj_glo, jbegin=jbegin, nj=nj, data_dim=2)
     278        CALL xios_set_domain_attr_hdl(dom, lonvalue=io_lon(ibegin:iend), latvalue=io_lat(jbegin:jend))
     279
     280        IF (.NOT.is_sequential) THEN
     281            mask(:,:)=.TRUE.
     282            if (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE.
     283            if (ii_end<ni) mask(ii_end+1:ni,nj) = .FALSE.
     284            ! special case for south pole
     285            if ((ii_end.eq.1).and.(is_south_pole)) mask(1:ni,nj)=.true.
     286            IF (prt_level >= 10) THEN
     287              WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1)
     288              WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,nj)=",mask(:,nj)
     289            ENDIF
     290            CALL xios_set_domain_attr_hdl(dom, mask=mask)
     291        END IF
     292
    208293         CALL xios_is_defined_domain_attr_hdl(dom,ni_glo=boool)
    209294        !Vérification:
    210295        IF (xios_is_valid_domain(dom_id)) THEN
    211             WRITE(*,*) "Xios. Domain initialized: ", dom_id, boool
    212         ELSE
    213             WRITE(*,*) "Xios. Invalid domain: ", dom_id
     296            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
     297        ELSE
     298            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id)
    214299        END IF
    215300    END SUBROUTINE wxios_domain_param
    … …  
    218303    ! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
    219304    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    220     SUBROUTINE wxios_add_vaxis(axisgroup_id, axis_file_id, axis_size, axis_value)
    221         CHARACTER (len=*), INTENT(IN) :: axisgroup_id
    222         INTEGER, INTENT(IN) :: axis_file_id, axis_size
     305    SUBROUTINE wxios_add_vaxis(axisgroup_id, axis_file, axis_size, axis_value)
     306        IMPLICIT NONE
     307        INCLUDE 'iniprint.h'
     308
     309        CHARACTER (len=*), INTENT(IN) :: axisgroup_id, axis_file
     310        INTEGER, INTENT(IN) :: axis_size
    223311        REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
    224312       
    225313        TYPE(xios_axisgroup) :: axgroup
    226314        TYPE(xios_axis) :: ax
    227         CHARACTER(len=100) :: axis_id
     315        CHARACTER(len=20) :: axis_id
    228316       
    229317       
    230318        !Préparation du nom de l'axe:
    231         CALL concat(axisgroup_id, axis_file_id, axis_id)
     319        CALL concat(axisgroup_id, axis_file, axis_id)
    232320       
    233321        !On récupère le groupe d'axes qui va bien:
    … …  
    235323       
    236324        !On ajoute l'axe correspondant à ce fichier:
    237         CALL xios_add_axis(axgroup, ax, axis_id)
     325        CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
    238326       
    239327        !Et on le parametrise:
    … …  
    241329       
    242330        !Vérification:
    243         IF (xios_is_valid_axis(axis_id)) THEN
    244             WRITE(*,*) "Xios. Axis created: ", axis_id
    245         ELSE
    246             WRITE(*,*) "Xios. Invalid axis: ", axis_id
     331        IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
     332            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
     333        ELSE
     334            WRITE(*,*) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
    247335        END IF
    248336
    … …  
    254342    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    255343    SUBROUTINE wxios_add_file(fname, ffreq, flvl)
     344        IMPLICIT NONE
     345        INCLUDE 'iniprint.h'
     346
    256347        CHARACTER(len=*), INTENT(IN) :: fname
    257348        CHARACTER(len=*), INTENT(IN) :: ffreq
    … …  
    262353        CHARACTER(len=100) :: nffreq
    263354       
    264         !On créé le noeud:
    265         CALL xios_get_filegroup_handle("defile", x_fg)
    266         CALL xios_add_file(x_fg, x_file, "X"//fname)
    267        
    268         !On reformate la fréquence:
    269         CALL reformadate(ffreq, nffreq)
    270        
    271         !On configure:
    272         CALL xios_set_file_attr_hdl(x_file, name="X"//fname,&
     355        !On regarde si le fichier n'est pas défini par XML:
     356        IF (.NOT.xios_is_valid_file(fname)) THEN
     357            !On créé le noeud:
     358            CALL xios_get_filegroup_handle("defile", x_fg)
     359            CALL xios_add_file(x_fg, x_file, fname)
     360       
     361            !On reformate la fréquence:
     362            CALL reformadate(ffreq, nffreq)
     363       
     364            !On configure:
     365            CALL xios_set_file_attr_hdl(x_file, name="X"//fname,&
    273366                output_freq=TRIM(ADJUSTL(nffreq)), output_level=flvl, enabled=.TRUE.)
    274367       
    275         IF (xios_is_valid_file("X"//fname)) THEN
    276             WRITE(*,*) "Xios. New file: ", "X"//fname
    277             WRITE(*,*) "Xios. output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
    278         ELSE
    279             WRITE(*,*) "Xios. Error, invalid file: ", "X"//fname
    280             WRITE(*,*) "Xios. output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
     368            IF (xios_is_valid_file("X"//fname)) THEN
     369                IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
     370                IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
     371            ELSE
     372                WRITE(*,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
     373                WRITE(*,*) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
     374            END IF
     375        ELSE
     376            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
     377                CALL xios_set_file_attr(fname, enabled=.TRUE.)
    281378        END IF
    282379    END SUBROUTINE wxios_add_file
    … …  
    286383    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    287384    SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
    288         USE netcdf
     385        USE netcdf, only: nf90_fill_real
     386
     387        IMPLICIT NONE
     388        INCLUDE 'iniprint.h'
    289389       
    290390        CHARACTER(len=*), INTENT(IN) :: fieldname
    … …  
    308408        !On ajoute le champ:
    309409        CALL xios_add_field(fieldgroup, field, fieldname)
    310         !WRITE(*,*) "Xios. ",fieldname,fieldgroup, fieldlongname, fieldunit
     410        !IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
    311411       
    312412        !On rentre ses paramètres:
    313413        CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def)
    314         WRITE(*,*) "Xios. Champ ", fieldname, "cree:"
    315         WRITE(*,*) "Xios. long_name=",fieldlongname,"; unit=",newunit,";  default_value=",nf90_fill_real
     414        IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:"
     415        IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: long_name=",trim(fieldlongname),"; unit=",trim(newunit),";  default_value=",nf90_fill_real
    316416
    317417    END SUBROUTINE wxios_add_field
    … …  
    321421    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    322422    SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op)
     423        IMPLICIT NONE
     424        INCLUDE 'iniprint.h'
     425
    323426        CHARACTER(len=*), INTENT(IN) :: fieldname
    324427        INTEGER, INTENT(IN)          :: fdim, fid
    … …  
    329432        CHARACTER(len=*), INTENT(IN) :: op
    330433       
    331         CHARACTER(len=100) :: axis_id
     434        CHARACTER(len=20) :: axis_id
    332435        CHARACTER(len=100) :: operation
    333436        TYPE(xios_file) :: f
    334437        TYPE(xios_field) :: field
    335438        TYPE(xios_fieldgroup) :: fieldgroup
     439        LOGICAL :: bool=.FALSE.
     440        INTEGER :: lvl =0
    336441       
    337442       
    338443        !Préparation du nom de l'axe:
    339         CALL concat("presnivs", fid, axis_id)
     444        CALL concat("presnivs", fname, axis_id)
    340445       
    341446        !on prépare le nom de l'opération:
    … …  
    352457       
    353458        !On regarde si le champ à déjà été créé ou non:
    354         IF (xios_is_valid_field(fieldname)) THEN
    355             WRITE(*,*) "Xios. Champ ", fieldname, "existe"
    356         ELSE
    357             WRITE(*,*) "Xios. Champ ", fieldname, "nexiste pas"
     459        IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
     460            !Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
     461            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
     462            g_flag_xml = .TRUE.
     463            g_field_name = fieldname
     464
     465        ELSE IF (.NOT. g_field_name == fieldname) THEN
     466            !Si premier pssage et champ indéfini, alors on le créé
     467
     468            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
    358469           
    359470            !On le créé:
    360471            CALL wxios_add_field(fieldname,  fieldgroup, fieldlongname, fieldunit)
    361472            IF (xios_is_valid_field(fieldname)) THEN
    362                 WRITE(*,*) "Xios. Champ ", fieldname, "cree"
     473                IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
    363474            ENDIF
    364         ENDIF
    365        
    366         !On ajoute le champ:
    367         CALL xios_get_file_handle("X"//fname, f)
    368         CALL xios_add_fieldtofile(f, field)
    369        
    370        
    371         !L'operation, sa frequence:
    372         CALL xios_set_field_attr_hdl(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op="1ts", prec=4)
    373 
    374        
    375         !On rentre ses paramètres:
    376         CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.)
    377        
    378         IF (fdim.EQ.2) THEN
    379             !Si c'est un champ 2D:
    380             WRITE(*,*) "Xios. Champ 2D ", fieldname, " de ", "X"//fname ," configure:"
    381             WRITE (*,*) "Xios. op=", TRIM(ADJUSTL(operation))
    382             WRITE(*,*) "Xios. freq_op=1ts","; lvl=",field_level
    383         ELSE
    384             !Si 3D :
    385             !On ajoute l'axe vertical qui va bien:
    386             CALL xios_set_field_attr_hdl(field, axis_ref=axis_id)
     475
     476            g_flag_xml = .FALSE.
     477            g_field_name = fieldname
     478
     479        END IF
     480
     481        IF (.NOT. g_flag_xml) THEN
     482            !Champ existe déjà, mais pas XML, alors on l'ajoute
     483            !On ajoute le champ:
     484            CALL xios_get_file_handle(fname, f)
     485            CALL xios_add_fieldtofile(f, field)
    387486           
    388             WRITE(*,*) "Xios. Champ 3D ", fieldname, " de ", "X"//fname, "configure:"
    389             WRITE(*,*) "Xios. freq_op=1ts","; lvl=",field_level
    390             WRITE(*,*) "Xios. axe=",axis_id
    391         END IF
     487           
     488            !L'operation, sa frequence:
     489            CALL xios_set_field_attr_hdl(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op="1ts", prec=4)
     490
     491           
     492            !On rentre ses paramètres:
     493            CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.)
     494           
     495            IF (fdim.EQ.2) THEN
     496                !Si c'est un champ 2D:
     497                IF (prt_level >= 10) THEN
     498                  WRITE(lunout,*) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X"//trim(fname) ," configured with:"
     499                  WRITE(lunout,*) "wxios_add_field_to_file: op=", TRIM(ADJUSTL(operation))
     500                  WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
     501                ENDIF
     502            ELSE
     503                !Si 3D :
     504                !On ajoute l'axe vertical qui va bien:
     505                CALL xios_set_field_attr_hdl(field, axis_ref=TRIM(ADJUSTL(axis_id)))
     506               
     507                IF (prt_level >= 10) THEN
     508                  WRITE(lunout,*) "wxios_add_field_to_file: 3D Field",trim(fieldname), " in ", "X"//trim(fname), "configured with:"
     509                  WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
     510                  WRITE(lunout,*) "wxios_add_field_to_file: axis=",TRIM(ADJUSTL(axis_id))
     511                ENDIF
     512            END IF
     513       
     514        ELSE
     515            !Sinon on se contente de l'activer:
     516            CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
     517        ENDIF       
    392518       
    393519    END SUBROUTINE wxios_add_field_to_file

  • trunk/LMDZ.COMMON/libf/dyn3d/gcm.F

    r1107 r1300  
    348348          start_time = starttime
    349349        ELSE
    350           WRITE(lunout,*)'Je m''arrete'
    351           CALL abort
     350          call abort_gcm("gcm", "'Je m''arrete'", 1)
    352351        ENDIF
    353352      ENDIF

  • trunk/LMDZ.COMMON/libf/dyn3d/guide_mod.F90

    r979 r1300  
    8787    CALL getpar('guide_teta',.false.,guide_teta,'guidage de T par Teta')
    8888
    89     CALL getpar('guide_add',.false.,guide_add,'for�age constant?')
     89    CALL getpar('guide_add',.false.,guide_add,'for�age constant?')
    9090    CALL getpar('guide_zon',.false.,guide_zon,'guidage moy zonale')
    9191
    … …  
    104104    CALL getpar('guide_BL',.true.,guide_BL,'guidage dans C.Lim')
    105105   
    106 ! Sauvegarde du for�age
     106! Sauvegarde du for�age
    107107    CALL getpar('guide_sav',.false.,guide_sav,'sauvegarde guidage')
    108108    CALL getpar('iguide_sav',4,iguide_sav,'freq. sauvegarde guidage')
    … …  
    143143    ncidpl=-99
    144144    if (guide_modele) then
    145        if (ncidpl.eq.-99) rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl)
     145       if (ncidpl.eq.-99) then
     146          rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl)
     147          if (rcod.NE.NF_NOERR) THEN
     148             print *,'Guide: probleme -> pas de fichier apbp.nc'
     149             CALL abort_gcm(modname,abort_message,1)
     150          endif
     151       endif
    146152    else
    147153         if (guide_u) then
    148            if (ncidpl.eq.-99) rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
     154           if (ncidpl.eq.-99) then
     155               rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
     156               if (rcod.NE.NF_NOERR) THEN
     157                  print *,'Guide: probleme -> pas de fichier u.nc'
     158                  CALL abort_gcm(modname,abort_message,1)
     159               endif
     160           endif
    149161         elseif (guide_v) then
    150            if (ncidpl.eq.-99) rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
     162           if (ncidpl.eq.-99) then
     163               rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
     164               if (rcod.NE.NF_NOERR) THEN
     165                  print *,'Guide: probleme -> pas de fichier v.nc'
     166                  CALL abort_gcm(modname,abort_message,1)
     167               endif
     168           endif
    151169         elseif (guide_T) then
    152            if (ncidpl.eq.-99) rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
     170           if (ncidpl.eq.-99) then
     171               rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
     172               if (rcod.NE.NF_NOERR) THEN
     173                  print *,'Guide: probleme -> pas de fichier T.nc'
     174                  CALL abort_gcm(modname,abort_message,1)
     175               endif
     176           endif
    153177         elseif (guide_Q) then
    154            if (ncidpl.eq.-99) rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
     178           if (ncidpl.eq.-99) then
     179               rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
     180               if (rcod.NE.NF_NOERR) THEN
     181                  print *,'Guide: probleme -> pas de fichier hur.nc'
     182                  CALL abort_gcm(modname,abort_message,1)
     183               endif
     184           endif
    155185         endif
    156186    endif
    … …  
    9901020    INTEGER               :: status,rcode
    9911021
     1022    CHARACTER (len = 80)   :: abort_message
     1023    CHARACTER (len = 20)   :: modname = 'guide_read'
    9921024! -----------------------------------------------------------------
    9931025! Premier appel: initialisation de la lecture des fichiers
    … …  
    9981030! Niveaux de pression si non constants
    9991031         if (guide_modele) then
    1000              print *,'Lecture du guidage sur niveaux mod�le'
     1032             print *,'Lecture du guidage sur niveaux modele'
    10011033             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
     1034             IF (rcode.NE.NF_NOERR) THEN
     1035              print *,'Guide: probleme -> pas de fichier apbp.nc'
     1036              CALL abort_gcm(modname,abort_message,1)
     1037             ENDIF
    10021038             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
     1039             IF (rcode.NE.NF_NOERR) THEN
     1040              print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
     1041              CALL abort_gcm(modname,abort_message,1)
     1042             ENDIF
    10031043             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
     1044             IF (rcode.NE.NF_NOERR) THEN
     1045              print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
     1046              CALL abort_gcm(modname,abort_message,1)
     1047             ENDIF
    10041048             print*,'ncidpl,varidap',ncidpl,varidap
    10051049         endif
    … …  
    10071051         if (guide_u) then
    10081052             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
     1053             IF (rcode.NE.NF_NOERR) THEN
     1054              print *,'Guide: probleme -> pas de fichier u.nc'
     1055              CALL abort_gcm(modname,abort_message,1)
     1056             ENDIF
    10091057             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
     1058             IF (rcode.NE.NF_NOERR) THEN
     1059              print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
     1060              CALL abort_gcm(modname,abort_message,1)
     1061             ENDIF
    10101062             print*,'ncidu,varidu',ncidu,varidu
    10111063             if (ncidpl.eq.-99) ncidpl=ncidu
    … …  
    10141066         if (guide_v) then
    10151067             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
     1068             IF (rcode.NE.NF_NOERR) THEN
     1069              print *,'Guide: probleme -> pas de fichier v.nc'
     1070              CALL abort_gcm(modname,abort_message,1)
     1071             ENDIF
    10161072             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
     1073             IF (rcode.NE.NF_NOERR) THEN
     1074              print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
     1075              CALL abort_gcm(modname,abort_message,1)
     1076             ENDIF
    10171077             print*,'ncidv,varidv',ncidv,varidv
    10181078             if (ncidpl.eq.-99) ncidpl=ncidv
    … …  
    10211081         if (guide_T) then
    10221082             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
     1083             IF (rcode.NE.NF_NOERR) THEN
     1084              print *,'Guide: probleme -> pas de fichier T.nc'
     1085              CALL abort_gcm(modname,abort_message,1)
     1086             ENDIF
    10231087             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
     1088             IF (rcode.NE.NF_NOERR) THEN
     1089              print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
     1090              CALL abort_gcm(modname,abort_message,1)
     1091             ENDIF
    10241092             print*,'ncidT,varidT',ncidt,varidt
    10251093             if (ncidpl.eq.-99) ncidpl=ncidt
    … …  
    10281096         if (guide_Q) then
    10291097             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
     1098             IF (rcode.NE.NF_NOERR) THEN
     1099              print *,'Guide: probleme -> pas de fichier hur.nc'
     1100              CALL abort_gcm(modname,abort_message,1)
     1101             ENDIF
    10301102             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
     1103             IF (rcode.NE.NF_NOERR) THEN
     1104              print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
     1105              CALL abort_gcm(modname,abort_message,1)
     1106             ENDIF
    10311107             print*,'ncidQ,varidQ',ncidQ,varidQ
    10321108             if (ncidpl.eq.-99) ncidpl=ncidQ
    … …  
    10351111         if ((guide_P).OR.(guide_modele)) then
    10361112             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
     1113             IF (rcode.NE.NF_NOERR) THEN
     1114              print *,'Guide: probleme -> pas de fichier ps.nc'
     1115              CALL abort_gcm(modname,abort_message,1)
     1116             ENDIF
    10371117             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
     1118             IF (rcode.NE.NF_NOERR) THEN
     1119              print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
     1120              CALL abort_gcm(modname,abort_message,1)
     1121             ENDIF
    10381122             print*,'ncidps,varidps',ncidps,varidps
    10391123         endif
    … …  
    11731257    INTEGER               :: i
    11741258
     1259    CHARACTER (len = 80)   :: abort_message
     1260    CHARACTER (len = 20)   :: modname = 'guide_read2D'
    11751261! -----------------------------------------------------------------
    11761262! Premier appel: initialisation de la lecture des fichiers
    … …  
    11811267! Niveaux de pression si non constants
    11821268         if (guide_modele) then
    1183              print *,'Lecture du guidage sur niveaux mod�le'
     1269             print *,'Lecture du guidage sur niveaux modele'
    11841270             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
     1271             IF (rcode.NE.NF_NOERR) THEN
     1272              print *,'Guide: probleme -> pas de fichier apbp.nc'
     1273              CALL abort_gcm(modname,abort_message,1)
     1274             ENDIF
    11851275             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
     1276             IF (rcode.NE.NF_NOERR) THEN
     1277              print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
     1278              CALL abort_gcm(modname,abort_message,1)
     1279             ENDIF
    11861280             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
     1281             IF (rcode.NE.NF_NOERR) THEN
     1282              print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
     1283              CALL abort_gcm(modname,abort_message,1)
     1284             ENDIF
    11871285             print*,'ncidpl,varidap',ncidpl,varidap
    11881286         endif
    … …  
    11901288         if (guide_u) then
    11911289             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
     1290             IF (rcode.NE.NF_NOERR) THEN
     1291              print *,'Guide: probleme -> pas de fichier u.nc'
     1292              CALL abort_gcm(modname,abort_message,1)
     1293             ENDIF
    11921294             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
     1295             IF (rcode.NE.NF_NOERR) THEN
     1296              print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
     1297              CALL abort_gcm(modname,abort_message,1)
     1298             ENDIF
    11931299             print*,'ncidu,varidu',ncidu,varidu
    11941300             if (ncidpl.eq.-99) ncidpl=ncidu
    … …  
    11971303         if (guide_v) then
    11981304             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
     1305             IF (rcode.NE.NF_NOERR) THEN
     1306              print *,'Guide: probleme -> pas de fichier v.nc'
     1307              CALL abort_gcm(modname,abort_message,1)
     1308             ENDIF
    11991309             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
     1310             IF (rcode.NE.NF_NOERR) THEN
     1311              print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
     1312              CALL abort_gcm(modname,abort_message,1)
     1313             ENDIF
    12001314             print*,'ncidv,varidv',ncidv,varidv
    12011315             if (ncidpl.eq.-99) ncidpl=ncidv
    … …  
    12041318         if (guide_T) then
    12051319             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
     1320             IF (rcode.NE.NF_NOERR) THEN
     1321              print *,'Guide: probleme -> pas de fichier T.nc'
     1322              CALL abort_gcm(modname,abort_message,1)
     1323             ENDIF
    12061324             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
     1325             IF (rcode.NE.NF_NOERR) THEN
     1326              print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
     1327              CALL abort_gcm(modname,abort_message,1)
     1328             ENDIF
    12071329             print*,'ncidT,varidT',ncidt,varidt
    12081330             if (ncidpl.eq.-99) ncidpl=ncidt
    … …  
    12111333         if (guide_Q) then
    12121334             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
     1335             IF (rcode.NE.NF_NOERR) THEN
     1336              print *,'Guide: probleme -> pas de fichier hur.nc'
     1337              CALL abort_gcm(modname,abort_message,1)
     1338             ENDIF
    12131339             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
     1340             IF (rcode.NE.NF_NOERR) THEN
     1341              print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
     1342              CALL abort_gcm(modname,abort_message,1)
     1343             ENDIF
    12141344             print*,'ncidQ,varidQ',ncidQ,varidQ
    12151345             if (ncidpl.eq.-99) ncidpl=ncidQ
    … …  
    12181348         if ((guide_P).OR.(guide_modele)) then
    12191349             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
     1350             IF (rcode.NE.NF_NOERR) THEN
     1351              print *,'Guide: probleme -> pas de fichier ps.nc'
     1352              CALL abort_gcm(modname,abort_message,1)
     1353             ENDIF
    12201354             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
     1355             IF (rcode.NE.NF_NOERR) THEN
     1356              print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
     1357              CALL abort_gcm(modname,abort_message,1)
     1358             ENDIF
    12211359             print*,'ncidps,varidps',ncidps,varidps
    12221360         endif
    … …  
    14271565#endif
    14281566! --------------------------------------------------------------------
    1429 ! Cr�ation des variables sauvegard�es
     1567! Cr�ation des variables sauvegard�es
    14301568! --------------------------------------------------------------------
    14311569        ierr = NF_REDEF(nid)
    … …  
    15521690!===========================================================================
    15531691END MODULE guide_mod
     1692

  • trunk/LMDZ.COMMON/libf/dyn3d_common/defrun.F

    r1299 r1300  
    370370        WRITE(tapeout,*)' La valeur de dzoomx passee par run.def est dif
    371371     *ferente de celle lue sur le fichier  start '
    372         CALL ABORT
     372        CALL ABORT_gcm("defrun", "", 1)
    373373       ENDIF
    374374
    … …  
    376376        WRITE(tapeout,*)' La valeur de dzoomy passee par run.def est dif
    377377     *ferente de celle lue sur le fichier  start '
    378         CALL ABORT
     378        CALL ABORT_gcm("defrun", "", 1)
    379379       ENDIF
    380380
    … …  
    382382        WRITE(6,*)' La valeur de taux passee par run.def est differente
    383383     *  de celle lue sur le fichier  start '
    384         CALL ABORT
     384        CALL ABORT_gcm("defrun", "", 1)
    385385       ENDIF
    386386
    … …  
    388388        WRITE(6,*)' La valeur de tauy passee par run.def est differente
    389389     *  de celle lue sur le fichier  start '
    390         CALL ABORT
     390        CALL ABORT_gcm("defrun", "", 1)
    391391       ENDIF
    392392

  • trunk/LMDZ.COMMON/libf/dyn3d_common/dynetat0.F

    r1299 r1300  
    8282        write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc'
    8383        write(lunout,*)trim(nf90_strerror(ierr))
    84         CALL ABORT
     84        CALL ABORT_gcm("dynetat0", "", 1)
    8585      ENDIF
    8686
    … …  
    9090         write(lunout,*)"dynetat0: Le champ <controle> est absent"
    9191         write(lunout,*)trim(nf90_strerror(ierr))
    92          CALL abort
     92         CALL ABORT_gcm("dynetat0", "", 1)
    9393      ENDIF
    9494      ierr = nf90_get_var(nid, nvarid, tab_cntrl)
    … …  
    9696         write(lunout,*)"dynetat0: Lecture echoue pour <controle>"
    9797         write(lunout,*)trim(nf90_strerror(ierr))
    98          CALL abort
     98         CALL ABORT_gcm("dynetat0", "", 1)
    9999      ENDIF
    100100
    … …  
    190190         write(lunout,*)"dynetat0: Le champ <rlonu> est absent"
    191191         write(lunout,*)trim(nf90_strerror(ierr))
    192          CALL abort
     192         CALL ABORT_gcm("dynetat0", "", 1)
    193193      ENDIF
    194194      ierr = nf90_get_var(nid, nvarid, rlonu)
    … …  
    196196         write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>"
    197197         write(lunout,*)trim(nf90_strerror(ierr))
    198          CALL abort
     198         CALL ABORT_gcm("dynetat0", "", 1)
    199199      ENDIF
    200200
    … …  
    203203         write(lunout,*)"dynetat0: Le champ <rlatu> est absent"
    204204         write(lunout,*)trim(nf90_strerror(ierr))
    205          CALL abort
     205         CALL ABORT_gcm("dynetat0", "", 1)
    206206      ENDIF
    207207      ierr = nf90_get_var(nid, nvarid, rlatu)
    … …  
    209209         write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>"
    210210         write(lunout,*)trim(nf90_strerror(ierr))
    211          CALL abort
     211         CALL ABORT_gcm("dynetat0", "", 1)
    212212      ENDIF
    213213
    … …  
    216216         write(lunout,*)"dynetat0: Le champ <rlonv> est absent"
    217217         write(lunout,*)trim(nf90_strerror(ierr))
    218          CALL abort
     218         CALL ABORT_gcm("dynetat0", "", 1)
    219219      ENDIF
    220220      ierr = nf90_get_var(nid, nvarid, rlonv)
    … …  
    222222         write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>"
    223223         write(lunout,*)trim(nf90_strerror(ierr))
    224          CALL abort
     224         CALL ABORT_gcm("dynetat0", "", 1)
    225225      ENDIF
    226226
    … …  
    229229         write(lunout,*)"dynetat0: Le champ <rlatv> est absent"
    230230         write(lunout,*)trim(nf90_strerror(ierr))
    231          CALL abort
     231         CALL ABORT_gcm("dynetat0", "", 1)
    232232      ENDIF
    233233      ierr = nf90_get_var(nid, nvarid, rlatv)
    … …  
    235235         write(lunout,*)"dynetat0: Lecture echouee pour rlatv"
    236236         write(lunout,*)trim(nf90_strerror(ierr))
    237          CALL abort
     237         CALL ABORT_gcm("dynetat0", "", 1)
    238238      ENDIF
    239239
    … …  
    242242         write(lunout,*)"dynetat0: Le champ <cu> est absent"
    243243         write(lunout,*)trim(nf90_strerror(ierr))
    244          CALL abort
     244         CALL ABORT_gcm("dynetat0", "", 1)
    245245      ENDIF
    246246      ierr = nf90_get_var(nid, nvarid, cu)
    … …  
    248248         write(lunout,*)"dynetat0: Lecture echouee pour <cu>"
    249249         write(lunout,*)trim(nf90_strerror(ierr))
    250          CALL abort
     250         CALL ABORT_gcm("dynetat0", "", 1)
    251251      ENDIF
    252252
    … …  
    255255         write(lunout,*)"dynetat0: Le champ <cv> est absent"
    256256         write(lunout,*)trim(nf90_strerror(ierr))
    257          CALL abort
     257         CALL ABORT_gcm("dynetat0", "", 1)
    258258      ENDIF
    259259      ierr = nf90_get_var(nid, nvarid, cv)
    … …  
    261261         write(lunout,*)"dynetat0: Lecture echouee pour <cv>"
    262262         write(lunout,*)trim(nf90_strerror(ierr))
    263          CALL abort
     263         CALL ABORT_gcm("dynetat0", "", 1)
    264264      ENDIF
    265265
    … …  
    268268         write(lunout,*)"dynetat0: Le champ <aire> est absent"
    269269         write(lunout,*)trim(nf90_strerror(ierr))
    270          CALL abort
     270         CALL ABORT_gcm("dynetat0", "", 1)
    271271      ENDIF
    272272      ierr = nf90_get_var(nid, nvarid, aire)
    … …  
    274274         write(lunout,*)"dynetat0: Lecture echouee pour <aire>"
    275275         write(lunout,*)trim(nf90_strerror(ierr))
    276          CALL abort
     276         CALL ABORT_gcm("dynetat0", "", 1)
    277277      ENDIF
    278278
    … …  
    281281         write(lunout,*)"dynetat0: Le champ <phisinit> est absent"
    282282         write(lunout,*)trim(nf90_strerror(ierr))
    283          CALL abort
     283         CALL ABORT_gcm("dynetat0", "", 1)
    284284      ENDIF
    285285      ierr = nf90_get_var(nid, nvarid, phis)
    … …  
    287287         write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>"
    288288         write(lunout,*)trim(nf90_strerror(ierr))
    289          CALL abort
     289         CALL ABORT_gcm("dynetat0", "", 1)
    290290      ENDIF
    291291
    … …  
    299299           write(lunout,*)"dynetat0: Le champ <Time> est absent"
    300300           write(lunout,*)trim(nf90_strerror(ierr))
    301            CALL abort
     301           CALL ABORT_gcm("dynetat0", "", 1)
    302302        ENDIF
    303303        ! Get the length of the "Time" dimension
    … …  
    311311           write(lunout,*)"dynetat0: Lecture echouee <Time>"
    312312           write(lunout,*)trim(nf90_strerror(ierr))
    313            CALL abort
     313           CALL ABORT_gcm("dynetat0", "", 1)
    314314        ENDIF
    315315      ELSE   
    … …  
    324324           write(lunout,*)"dynetat0: Lecture echouee <temps>"
    325325           write(lunout,*)trim(nf90_strerror(ierr))
    326            CALL abort
     326           CALL ABORT_gcm("dynetat0", "", 1)
    327327        ENDIF
    328328      ENDIF
    … …  
    346346             PRINT*, time(i)
    347347          ENDDO
    348           CALL abort
     348          CALL ABORT_gcm("dynetat0", "", 1)
    349349        ENDIF
    350350      ENDIF
    … …  
    379379         write(lunout,*)"dynetat0: Le champ <vcov> est absent"
    380380         write(lunout,*)trim(nf90_strerror(ierr))
    381          CALL abort
     381         CALL ABORT_gcm("dynetat0", "", 1)
    382382      ENDIF
    383383      ierr=nf90_get_var(nid,nvarid,vcov,corner,edges)
    … …  
    385385         write(lunout,*)"dynetat0: Lecture echouee pour <vcov>"
    386386         write(lunout,*)trim(nf90_strerror(ierr))
    387          CALL abort
     387         CALL ABORT_gcm("dynetat0", "", 1)
    388388      ENDIF
    389389
    … …  
    401401         write(lunout,*)"dynetat0: Le champ <ucov> est absent"
    402402         write(lunout,*)trim(nf90_strerror(ierr))
    403          CALL abort
     403         CALL ABORT_gcm("dynetat0", "", 1)
    404404      ENDIF
    405405      ierr=nf90_get_var(nid,nvarid,ucov,corner,edges)
    … …  
    407407         write(lunout,*)"dynetat0: Lecture echouee pour <ucov>"
    408408         write(lunout,*)trim(nf90_strerror(ierr))
    409          CALL abort
     409         CALL ABORT_gcm("dynetat0", "", 1)
    410410      ENDIF
    411411 
    … …  
    415415         write(lunout,*)"dynetat0: Le champ <teta> est absent"
    416416         write(lunout,*)trim(nf90_strerror(ierr))
    417          CALL abort
     417         CALL ABORT_gcm("dynetat0", "", 1)
    418418      ENDIF
    419419      ierr=nf90_get_var(nid,nvarid,teta,corner,edges)
    … …  
    421421         write(lunout,*)"dynetat0: Lecture echouee pour <teta>"
    422422         write(lunout,*)trim(nf90_strerror(ierr))
    423          CALL abort
     423         CALL ABORT_gcm("dynetat0", "", 1)
    424424      ENDIF
    425425
    … …  
    439439     &                                //trim(tname(iq))
    440440            write(lunout,*)trim(nf90_strerror(ierr))
    441             CALL abort
     441            CALL ABORT_gcm("dynetat0", "", 1)
    442442          ENDIF
    443443        ENDIF
    … …  
    450450         write(lunout,*)"dynetat0: Le champ <masse> est absent"
    451451         write(lunout,*)trim(nf90_strerror(ierr))
    452          CALL abort
     452         CALL ABORT_gcm("dynetat0", "", 1)
    453453      ENDIF
    454454      ierr=nf90_get_var(nid,nvarid,masse,corner,edges)
    … …  
    456456         write(lunout,*)"dynetat0: Lecture echouee pour <masse>"
    457457         write(lunout,*)trim(nf90_strerror(ierr))
    458          CALL abort
     458         CALL ABORT_gcm("dynetat0", "", 1)
    459459      ENDIF
    460460
    … …  
    470470         write(lunout,*)"dynetat0: Le champ <ps> est absent"
    471471         write(lunout,*)trim(nf90_strerror(ierr))
    472          CALL abort
     472         CALL ABORT_gcm("dynetat0", "", 1)
    473473      ENDIF
    474474      ierr=nf90_get_var(nid,nvarid,ps,corner,edges)
    … …  
    476476         write(lunout,*)"dynetat0: Lecture echouee pour <ps>"
    477477         write(lunout,*)trim(nf90_strerror(ierr))
    478          CALL abort
     478         CALL ABORT_gcm("dynetat0", "", 1)
    479479      ENDIF
    480480

  • trunk/LMDZ.COMMON/libf/dyn3d_common/dynredem.F

    r1299 r1300  
    158158     &                  //trim(fichnom)
    159159         write(lunout,*)' ierr = ', ierr
    160          CALL ABORT
     160         CALL ABORT_GCM("DYNREDEM0", "", 1)
    161161      ENDIF
    162162c
    … …  
    636636      IF (ierr .NE. NF_NOERR) THEN
    637637         PRINT*, "dynredem1: Pb. d ouverture "//trim(fichnom)
    638          CALL abort
     638         CALL abort_gcm("dynredem1", "", 1)
    639639      ENDIF
    640640

  • trunk/LMDZ.COMMON/libf/dyn3d_common/fxhyp.F

    r1299 r1300  
    178178        WRITE(6,*)'Modifier les valeurs de  grossismx ,tau ou dzoomx ',
    179179     , ' et relancer ! ***  '
    180         CALL ABORT
     180        CALL ABORT_GCM("FXHYP", "", 1)
    181181       ENDIF
    182182c

  • trunk/LMDZ.COMMON/libf/dyn3d_common/fyhyp.F

    r1299 r1300  
    162162        WRITE(6,*)'Modifier les valeurs de  grossismy ,tauy ou dzoomy',
    163163     , ' et relancer ! ***  '
    164         CALL ABORT
     164        CALL ABORT_GCM("FYHYP", "", 1)
    165165
    166166       ENDIF

  • trunk/LMDZ.COMMON/libf/dyn3d_common/grid_atob.F

    r1299 r1300  
    5555      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
    5656         PRINT*, 'imar ou jmar trop grand', imar, jmar
    57          CALL ABORT
     57         CALL ABORT_GCM("", "", 1)
    5858      ENDIF
    5959c
    … …  
    119119         ELSE
    120120         PRINT*, 'probleme,i,j=', i,j
    121 ccc         CALL ABORT
     121ccc         CALL ABORT_GCM("", "", 1)
    122122         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
    123123#ifdef CRAY
    … …  
    193193      IF (imar.GT.400 .OR. jmar.GT.200) THEN
    194194         PRINT*, 'imar ou jmar trop grand', imar, jmar
    195          CALL ABORT
     195         CALL ABORT_GCM("", "", 1)
    196196      ENDIF
    197197c
    198198      IF (imdep.GT.400 .OR. jmdep.GT.200) THEN
    199199         PRINT*, 'imdep ou jmdep trop grand', imdep, jmdep
    200          CALL ABORT
     200         CALL ABORT_GCM("", "", 1)
    201201      ENDIF
    202202c
    … …  
    258258            PRINT*, 'Probleme grave,i,j,indx,indy=',
    259259     .              i,j,indx(i,j),indy(i,j)
    260             CALL abort
     260            CALL abort_gcm("", "", 1)
    261261         ENDIF
    262262      ENDDO
    … …  
    309309         ELSE
    310310         PRINT*, 'probleme,i,j=', i,j
    311          CALL ABORT
     311         CALL ABORT_GCM("", "", 1)
    312312         ENDIF
    313313      ENDDO
    … …  
    345345      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
    346346         PRINT*, 'imar ou jmar trop grand', imar, jmar
    347          CALL ABORT
     347         CALL ABORT_GCM("", "", 1)
    348348      ENDIF
    349349c
    … …  
    409409         ELSE
    410410         PRINT*, 'probleme,i,j=', i,j
    411          CALL ABORT
     411         CALL ABORT_GCM("", "", 1)
    412412         ENDIF
    413413      ENDDO
    … …  
    452452      IF (imar.GT.400 .OR. jmar.GT.400) THEN
    453453         PRINT*, 'imar ou jmar trop grand', imar, jmar
    454          CALL ABORT
     454         CALL ABORT_GCM("", "", 1)
    455455      ENDIF
    456456c
    … …  
    513513         ELSE
    514514            PRINT*, 'probleme,i,j=', i,j
    515 ccc            CALL ABORT
     515ccc            CALL ABORT_GCM("", "", 1)
    516516         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
    517517#ifdef CRAY
    … …  
    577577      IF (imar.GT.400 .OR. jmar.GT.400) THEN
    578578         PRINT*, 'imar ou jmar trop grand', imar, jmar
    579          CALL ABORT
     579         CALL ABORT_GCM("", "", 1)
    580580      ENDIF
    581581c
    … …  
    642642         ELSE
    643643           PRINT*, 'probleme,i,j=', i,j
    644 ccc           CALL ABORT
     644ccc           CALL ABORT_GCM("", "", 1)
    645645         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
    646646#ifdef CRAY
    … …  
    712712      IF (immod.GT.2200 .OR. jmmod.GT.1100) THEN
    713713         PRINT*, 'immod ou jmmod trop grand', immod, jmmod
    714          CALL ABORT
     714         CALL ABORT_GCM("", "", 1)
    715715      ENDIF
    716716c
    … …  
    801801         ELSE
    802802         PRINT*, 'probleme,i,j=', i,j
    803          CALL ABORT
     803         CALL ABORT_GCM("", "", 1)
    804804         ENDIF
    805805      ENDDO
    … …  
    875875         ELSE
    876876         PRINT*, 'probleme,i,j=', i,j
    877 ccc         CALL ABORT
     877ccc         CALL ABORT_GCM("", "", 1)
    878878         CALL dist_sphe(xmod(i),ymod(j),xtmp,ytmp,imtmp,jmtmp,distans)
    879879#ifdef CRAY

  • trunk/LMDZ.COMMON/libf/dyn3d_common/inigrads.F

    r1299 r1300  
    1313      real xmin,xmax,ymin,ymax
    1414
    15       character file*10,titlel*40
     15      character(len=*),intent(in) :: file
     16      character(len=*),intent(in) :: titlel
    1617
    1718#include "gradsdef.h"

  • trunk/LMDZ.COMMON/libf/dyn3d_common/juldate.F

    r1299 r1300  
    99        implicit real (a-h,o-z)
    1010        frac=((os/60.+om)/60.+oh)/24.
    11         ojou=dfloat(ijou)+frac
    12             year=dfloat(ian)
    13             rmon=dfloat(imoi)
     11        ojou=dble(ijou)+frac
     12            year=dble(ian)
     13            rmon=dble(imoi)
    1414        if (imoi .le. 2) then
    1515            year=year-1.

  • trunk/LMDZ.COMMON/libf/dyn3d_common/pres2lev_mod.F90

    r1299 r1300  
    2727  INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
    2828 
     29  INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontal
    2930  REAL, INTENT(IN) :: po(ni*nj,lmo) ! niveau de pression ancienne grille
    3031  REAL, INTENT(IN) :: pn(ni*nj,lmn) ! niveau de pression nouvelle grille
    31 
    32   INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontal
    3332
    3433  REAL, INTENT(IN)  :: varo(ni*nj,lmo) ! var dans l'ancienne grille

  • trunk/LMDZ.COMMON/libf/dyn3d_common/ran1.F

    r1299 r1300  
    2828      IX3=MOD(IA3*IX3+IC3,M3)
    2929      J=1+(97*IX3)/M3
    30       IF(J.GT.97.OR.J.LT.1)PAUSE
     30      IF(J.GT.97.OR.J.LT.1) stop 1
    3131      RAN1=R(J)
    3232      R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1

  • trunk/LMDZ.COMMON/libf/dyn3dpar/abort_gcm.F

    r1019 r1300  
    11!
    2 ! $Id: abort_gcm.F 1748 2013-04-24 14:18:40Z emillour $
     2! $Id: abort_gcm.F 1907 2013-11-26 13:10:46Z lguez $
    33!
    44c
    … …  
    1313#endif
    1414      USE parallel_lmdz
     15
     16
     17
     18
    1519#include "iniprint.h"
    1620 
    … …  
    3741c$OMP END MASTER
    3842#endif
     43
     44
     45
    3946c     call histclo(2)
    4047c     call histclo(3)
    … …  
    5663      endif
    5764      END
     65

  • trunk/LMDZ.COMMON/libf/dyn3dpar/bilan_dyn_p.F

    r1019 r1300  
    11!
    2 ! $Id: bilan_dyn_p.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: bilan_dyn_p.F 1907 2013-11-26 13:10:46Z lguez $
    33!
    44      SUBROUTINE bilan_dyn_p (ntrac,dt_app,dt_cum,
    … …  
    1616      USE mod_hallo
    1717      use misc_mod
    18       use write_field
     18      use write_field_p
    1919      IMPLICIT NONE
    2020
    … …  
    5757c   =======
    5858
    59       integer icum,ncum
    60       logical first
    61       real zz,zqy,zfactv(jjm,llm)
    62 
    63       integer nQ
    64       parameter (nQ=7)
     59      integer,save :: icum,ncum
     60!$OMP THREADPRIVATE(icum,ncum)
     61      logical,SAVE :: first=.true.
     62!$OMP THREADPRIVATE(first)
     63
     64      real zz,zqy
     65      real,save :: zfactv(jjm,llm)
     66
     67      integer,parameter :: nQ=7
    6568
    6669
    6770cym      character*6 nom(nQ)
    6871cym      character*6 unites(nQ)
    69       character*6,save :: nom(nQ)
    70       character*6,save :: unites(nQ)
    71 
    72       character*10 file
     72      character(len=6),save :: nom(nQ)
     73      character(len=6),save :: unites(nQ)
     74
     75      character(len=10) file
    7376      integer ifile
    7477      parameter (ifile=4)
    7578
    76       integer itemp,igeop,iecin,iang,iu,iovap,iun
    77       integer i_sortie
    78 
    79       save first,icum,ncum
    80       save itemp,igeop,iecin,iang,iu,iovap,iun
    81       save i_sortie
    82 
    83       real time
    84       integer itau
    85       save time,itau
    86       data time,itau/0.,0/
    87 
    88       data first/.true./
    89       data itemp,igeop,iecin,iang,iu,iovap,iun/1,2,3,4,5,6,7/
    90       data i_sortie/1/
     79      integer,PARAMETER :: itemp=1,igeop=2,iecin=3,iang=4,iu=5
     80      INTEGER,PARAMETER :: iovap=6,iun=7
     81      integer,PARAMETER :: i_sortie=1
     82
     83      real,SAVE :: time=0.
     84      integer,SAVE :: itau=0.
     85!$OMP THREADPRIVATE(time,itau)
    9186
    9287      real ww
    9388
    9489c   variables dynamiques intermédiaires
    95       REAL vcont(iip1,jjm,llm),ucont(iip1,jjp1,llm)
    96       REAL ang(iip1,jjp1,llm),unat(iip1,jjp1,llm)
    97       REAL massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)
    98       REAL vorpot(iip1,jjm,llm)
    99       REAL w(iip1,jjp1,llm),ecin(iip1,jjp1,llm),convm(iip1,jjp1,llm)
    100       REAL bern(iip1,jjp1,llm)
     90      REAL,save :: vcont(iip1,jjm,llm),ucont(iip1,jjp1,llm)
     91      REAL,save :: ang(iip1,jjp1,llm),unat(iip1,jjp1,llm)
     92      REAL,save :: massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)
     93      REAL,save :: vorpot(iip1,jjm,llm)
     94      REAL,save :: w(iip1,jjp1,llm),ecin(iip1,jjp1,llm)
     95      REAL,save ::convm(iip1,jjp1,llm)
     96      REAL,save :: bern(iip1,jjp1,llm)
    10197
    10298c   champ contenant les scalaires advectés.
    103       real Q(iip1,jjp1,llm,nQ)
     99      real,save :: Q(iip1,jjp1,llm,nQ)
    104100   
    105101c   champs cumulés
    106       real ps_cum(iip1,jjp1)
    107       real masse_cum(iip1,jjp1,llm)
    108       real flux_u_cum(iip1,jjp1,llm)
    109       real flux_v_cum(iip1,jjm,llm)
    110       real Q_cum(iip1,jjp1,llm,nQ)
    111       real flux_uQ_cum(iip1,jjp1,llm,nQ)
    112       real flux_vQ_cum(iip1,jjm,llm,nQ)
    113       real flux_wQ_cum(iip1,jjp1,llm,nQ)
    114       real dQ(iip1,jjp1,llm,nQ)
    115 
    116       save ps_cum,masse_cum,flux_u_cum,flux_v_cum
    117       save Q_cum,flux_uQ_cum,flux_vQ_cum
     102      real,save :: ps_cum(iip1,jjp1)
     103      real,save :: masse_cum(iip1,jjp1,llm)
     104      real,save :: flux_u_cum(iip1,jjp1,llm)
     105      real,save :: flux_v_cum(iip1,jjm,llm)
     106      real,save :: Q_cum(iip1,jjp1,llm,nQ)
     107      real,save :: flux_uQ_cum(iip1,jjp1,llm,nQ)
     108      real,save :: flux_vQ_cum(iip1,jjm,llm,nQ)
     109      real,save :: flux_wQ_cum(iip1,jjp1,llm,nQ)
     110      real,save :: dQ(iip1,jjp1,llm,nQ)
     111
    118112
    119113c   champs de tansport en moyenne zonale
    … …  
    128122      character*10,save :: zunites(ntr,nQ)
    129123
    130       integer iave,itot,immc,itrs,istn
    131       data iave,itot,immc,itrs,istn/1,2,3,4,5/
     124      INTEGER,PARAMETER :: iave=1,itot=2,immc=3,itrs=4,istn=5
     125
    132126      character*3 ctrs(ntr)
    133127      data ctrs/'  ','TOT','MMC','TRS','STN'/
    134128
    135       real zvQ(jjm,llm,ntr,nQ),zvQtmp(jjm,llm)
    136       real zavQ(jjm,ntr,nQ),psiQ(jjm,llm+1,nQ)
    137       real zmasse(jjm,llm),zamasse(jjm)
    138 
    139       real zv(jjm,llm),psi(jjm,llm+1)
     129      real,save :: zvQ(jjm,llm,ntr,nQ),zvQtmp(jjm,llm)
     130      real,save :: zavQ(jjm,ntr,nQ),psiQ(jjm,llm+1,nQ)
     131      real,save :: zmasse(jjm,llm),zamasse(jjm)
     132
     133      real,save :: zv(jjm,llm),psi(jjm,llm+1)
    140134
    141135      integer i,j,l,iQ
    … …  
    151145      save fileid
    152146
    153       integer ndex3d(jjm*llm)
     147      integer,save :: ndex3d(jjm*llm)
    154148
    155149C   Variables locales
    … …  
    162156      integer zan, dayref
    163157C
    164       real rlong(jjm),rlatg(jjm)
     158      real,save :: rlong(jjm),rlatg(jjm)
    165159      integer :: jjb,jje,jjn,ijb,ije
    166       type(Request) :: Req
     160      type(Request),SAVE :: Req
     161!$OMP THREADPRIVATE(Req)
    167162
    168163! definition du domaine d'ecriture pour le rebuild
    … …  
    182177c   Initialisation
    183178c=====================================================================
    184       ndex3d=0
    185179      if (adjust) return
    186180     
    … …  
    190184      if (first) then
    191185
     186        ndex3d=0
    192187
    193188        icum=0
    … …  
    202197           WRITE(lunout,*)'dt_cum=',dt_cum
    203198           stop
     199        else
     200          write(lunout,*) "bilan_dyn_p: ncum=",ncum
    204201        endif
    205202
    206         if (i_sortie.eq.1) then
    207          file='dynzon'
    208          if (mpi_rank==0) then
    209          call inigrads(ifile,1
    210      s  ,0.,180./pi,0.,0.,jjm,rlatv,-90.,90.,180./pi
    211      s  ,llm,presnivs,1.
    212      s  ,dt_cum,file,'dyn_zon ')
    213          endif
    214         endif
    215 
     203!        if (i_sortie.eq.1) then
     204!        file='dynzon'
     205!         if (mpi_rank==0) then
     206!        call inigrads(ifile,1
     207!     s  ,0.,180./pi,0.,0.,jjm,rlatv,-90.,90.,180./pi
     208!     s  ,llm,presnivs,1.
     209!     s  ,dt_cum,file,'dyn_zon ')
     210!         endif
     211!        endif
     212
     213!$OMP MASTER
    216214        nom(itemp)='T'
    217215        nom(igeop)='gz'
    … …  
    339337               CALL histend(fileid)
    340338
    341 
     339!$OMP END MASTER
     340!$OMP BARRIER
    342341      endif
    343342
    … …  
    351350   
    352351c   énergie cinétique
    353       ucont(:,jjb:jje,:)=0
     352!      ucont(:,jjb:jje,:)=0
    354353
    355354      call Register_Hallo(ucov,ip1jmp1,llm,1,1,1,1,Req)
    356355      call Register_Hallo(vcov,ip1jm,llm,1,1,1,1,Req)
    357356      call SendRequest(Req)
     357c$OMP BARRIER
    358358      call WaitRequest(Req)
     359c$OMP BARRIER
    359360
    360361      CALL covcont_p(llm,ucov,vcov,ucont,vcont)
    … …  
    362363
    363364c   moment cinétique
     365!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    364366      do l=1,llm
    365367         ang(:,jjb:jje,l)=ucov(:,jjb:jje,l)+constang(:,jjb:jje)
    366368         unat(:,jjb:jje,l)=ucont(:,jjb:jje,l)*cu(:,jjb:jje)
    367369      enddo
    368 
    369       Q(:,jjb:jje,:,itemp)=teta(:,jjb:jje,:)*pk(:,jjb:jje,:)/cpp
    370       Q(:,jjb:jje,:,igeop)=phi(:,jjb:jje,:)
    371       Q(:,jjb:jje,:,iecin)=ecin(:,jjb:jje,:)
    372       Q(:,jjb:jje,:,iang)=ang(:,jjb:jje,:)
    373       Q(:,jjb:jje,:,iu)=unat(:,jjb:jje,:)
    374       Q(:,jjb:jje,:,iovap)=trac(:,jjb:jje,:,1)
    375       Q(:,jjb:jje,:,iun)=1.
    376 
     370!$OMP END DO
     371
     372!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     373      DO l=1,llm
     374        Q(:,jjb:jje,l,itemp)=teta(:,jjb:jje,l)*pk(:,jjb:jje,l)/cpp
     375        Q(:,jjb:jje,l,igeop)=phi(:,jjb:jje,l)
     376        Q(:,jjb:jje,l,iecin)=ecin(:,jjb:jje,l)
     377        Q(:,jjb:jje,l,iang)=ang(:,jjb:jje,l)
     378        Q(:,jjb:jje,l,iu)=unat(:,jjb:jje,l)
     379        Q(:,jjb:jje,l,iovap)=trac(:,jjb:jje,l,1)
     380        Q(:,jjb:jje,l,iun)=1.
     381      ENDDO
     382!$OMP END DO NOWAIT
    377383
    378384c=====================================================================
    … …  
    384390         jje=jj_end
    385391
     392!$OMP MASTER
    386393         ps_cum(:,jjb:jje)=0.
    387          masse_cum(:,jjb:jje,:)=0.
    388          flux_u_cum(:,jjb:jje,:)=0.
    389          Q_cum(:,jjb:jje,:,:)=0.
    390          flux_uQ_cum(:,jjb:jje,:,:)=0.
    391          if (pole_sud) jje=jj_end-1
    392          flux_v_cum(:,jjb:jje,:)=0.
    393          flux_vQ_cum(:,jjb:jje,:,:)=0.
     394!$OMP END MASTER
     395!$OMP BARRIER
     396
     397!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     398        DO l=1,llm
     399          masse_cum(:,jjb:jje,l)=0.
     400          flux_u_cum(:,jjb:jje,l)=0.
     401          Q_cum(:,jjb:jje,l,:)=0.
     402          flux_uQ_cum(:,jjb:jje,l,:)=0.
     403          if (pole_sud) jje=jj_end-1
     404          flux_v_cum(:,jjb:jje,l)=0.
     405          flux_vQ_cum(:,jjb:jje,l,:)=0.
     406        ENDDO
     407!$OMP END DO NOWAIT
    394408      endif
    395409
    … …  
    402416      jje=jj_end
    403417
     418!$OMP MASTER
    404419      ps_cum(:,jjb:jje)=ps_cum(:,jjb:jje)+ps(:,jjb:jje)
    405       masse_cum(:,jjb:jje,:)=masse_cum(:,jjb:jje,:)+masse(:,jjb:jje,:)
    406       flux_u_cum(:,jjb:jje,:)=flux_u_cum(:,jjb:jje,:)
    407      .                       +flux_u(:,jjb:jje,:)
     420!$OMP END MASTER
     421!$OMP BARRIER
     422
     423!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     424      DO l=1,llm
     425        masse_cum(:,jjb:jje,l)=masse_cum(:,jjb:jje,l)+masse(:,jjb:jje,l)
     426        flux_u_cum(:,jjb:jje,l)=flux_u_cum(:,jjb:jje,l)
     427     .                         +flux_u(:,jjb:jje,l)
     428      ENDDO
     429!$OMP END DO NOWAIT
     430     
    408431      if (pole_sud) jje=jj_end-1
    409       flux_v_cum(:,jjb:jje,:)=flux_v_cum(:,jjb:jje,:)
    410      .                         +flux_v(:,jjb:jje,:)
    411 
    412       jjb=jj_begin
    413       jje=jj_end
    414 
    415       do iQ=1,nQ
    416         Q_cum(:,jjb:jje,:,iQ)=Q_cum(:,jjb:jje,:,iQ)
    417      .                       +Q(:,jjb:jje,:,iQ)*masse(:,jjb:jje,:)
     432
     433!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     434      DO l=1,llm
     435       flux_v_cum(:,jjb:jje,l)=flux_v_cum(:,jjb:jje,l)
     436     .                          +flux_v(:,jjb:jje,l)
     437      ENDDO
     438!$OMP END DO NOWAIT
     439     
     440      jjb=jj_begin
     441      jje=jj_end
     442
     443      do iQ=1,nQ
     444!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     445        DO l=1,llm
     446          Q_cum(:,jjb:jje,l,iQ)=Q_cum(:,jjb:jje,l,iQ)
     447     .                       +Q(:,jjb:jje,l,iQ)*masse(:,jjb:jje,l)
     448        ENDDO
     449!$OMP END DO NOWAIT
    418450      enddo
    419451
    … …  
    425457c   -----------------
    426458      do iQ=1,nQ
     459!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    427460         do l=1,llm
    428461            do j=jjb,jje
    … …  
    434467            enddo
    435468         enddo
     469!$OMP END DO NOWAIT
    436470      enddo
    437471
    … …  
    442476      enddo
    443477      call SendRequest(Req)
     478!$OMP BARRIER     
    444479      call WaitRequest(Req)
    445      
     480!$OMP BARRIER
     481
    446482      jjb=jj_begin
    447483      jje=jj_end
    … …  
    449485     
    450486      do iQ=1,nQ
     487!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    451488         do l=1,llm
    452489            do j=jjb,jje
    … …  
    457494            enddo
    458495         enddo
     496!$OMP END DO NOWAIT
    459497      enddo
    460498
    … …  
    467505      call Register_Hallo(flux_vQ_cum,ip1jm,llm,2,2,2,2,Req)
    468506      call SendRequest(Req)
     507!$OMP BARRIER     
    469508      call WaitRequest(Req)
     509c$OMP BARRIER
    470510
    471511      call  convflu_p(flux_uQ_cum,flux_vQ_cum,llm*nQ,dQ)
    … …  
    475515      call Register_Hallo(flux_v_cum,ip1jm,llm,2,2,2,2,Req)
    476516      call SendRequest(Req)
     517!$OMP BARRIER     
    477518      call WaitRequest(Req)
     519c$OMP BARRIER
    478520
    479521      call convmas_p(flux_u_cum,flux_v_cum,convm)
    480522      CALL vitvert_p(convm,w)
    481 
    482       jjb=jj_begin
    483       jje=jj_end
    484 
    485       do iQ=1,nQ
    486          do l=1,llm-1
    487             do j=jjb,jje
    488                do i=1,iip1
    489                   ww=-0.5*w(i,j,l+1)*(Q(i,j,l,iQ)+Q(i,j,l+1,iQ))
    490                   dQ(i,j,l  ,iQ)=dQ(i,j,l  ,iQ)-ww
    491                   dQ(i,j,l+1,iQ)=dQ(i,j,l+1,iQ)+ww
    492                enddo
    493             enddo
    494          enddo
     523!$OMP BARRIER     
     524
     525      jjb=jj_begin
     526      jje=jj_end
     527
     528      do iQ=1,nQ
     529!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     530         do l=1,llm
     531            IF (l<llm) THEN
     532              do j=jjb,jje
     533                 do i=1,iip1
     534                    ww=-0.5*w(i,j,l+1)*(Q(i,j,l,iQ)+Q(i,j,l+1,iQ))
     535                    dQ(i,j,l  ,iQ)=dQ(i,j,l  ,iQ)-ww
     536                    dQ(i,j,l+1,iQ)=dQ(i,j,l+1,iQ)+ww
     537                 enddo
     538              enddo
     539            ENDIF
     540            IF (l>2) THEN
     541              do j=jjb,jje
     542                do i=1,iip1
     543                  ww=-0.5*w(i,j,l)*(Q(i,j,l-1,iQ)+Q(i,j,l,iQ))
     544                  dQ(i,j,l,iQ)=dQ(i,j,l,iQ)+ww
     545                enddo
     546              enddo
     547            ENDIF
     548         enddo
     549!$OMP ENDDO NOWAIT
    495550      enddo
    496551      IF (prt_level > 5)
    … …  
    505560     . WRITE(lunout,*)'Pas d ecriture'
    506561
     562      jjb=jj_begin
     563      jje=jj_end
     564
    507565c   Normalisation
    508566      do iQ=1,nQ
    509          Q_cum(:,jjb:jje,:,iQ)=Q_cum(:,jjb:jje,:,iQ)
    510      .                        /masse_cum(:,jjb:jje,:)
    511       enddo
     567!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     568        do l=1,llm
     569          Q_cum(:,jjb:jje,l,iQ)=Q_cum(:,jjb:jje,l,iQ)
     570     .                          /masse_cum(:,jjb:jje,l)
     571        enddo
     572!$OMP ENDDO NOWAIT
     573      enddo
     574
    512575      zz=1./REAL(ncum)
    513576
    514       jjb=jj_begin
    515       jje=jj_end
    516 
     577!$OMP MASTER
    517578      ps_cum(:,jjb:jje)=ps_cum(:,jjb:jje)*zz
    518       masse_cum(:,jjb:jje,:)=masse_cum(:,jjb:jje,:)*zz
    519       flux_u_cum(:,jjb:jje,:)=flux_u_cum(:,jjb:jje,:)*zz
    520       flux_uQ_cum(:,jjb:jje,:,:)=flux_uQ_cum(:,jjb:jje,:,:)*zz
    521       dQ(:,jjb:jje,:,:)=dQ(:,jjb:jje,:,:)*zz
     579!$OMP END MASTER
     580
     581!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     582      DO l=1,llm
     583        masse_cum(:,jjb:jje,l)=masse_cum(:,jjb:jje,l)*zz
     584        flux_u_cum(:,jjb:jje,l)=flux_u_cum(:,jjb:jje,l)*zz
     585        flux_uQ_cum(:,jjb:jje,l,:)=flux_uQ_cum(:,jjb:jje,l,:)*zz
     586        dQ(:,jjb:jje,l,:)=dQ(:,jjb:jje,l,:)*zz
     587      ENDDO
     588!$OMP ENDDO NOWAIT
     589         
    522590     
    523591      IF (pole_sud) jje=jj_end-1
    524       flux_v_cum(:,jjb:jje,:)=flux_v_cum(:,jjb:jje,:)*zz
    525       flux_vQ_cum(:,jjb:jje,:,:)=flux_vQ_cum(:,jjb:jje,:,:)*zz
     592!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     593      DO l=1,llm
     594        flux_v_cum(:,jjb:jje,l)=flux_v_cum(:,jjb:jje,l)*zz
     595        flux_vQ_cum(:,jjb:jje,l,:)=flux_vQ_cum(:,jjb:jje,l,:)*zz
     596      ENDDO
     597!$OMP ENDDO
    526598
    527599      jjb=jj_begin
    … …  
    532604c   division de dQ par la masse pour revenir aux bonnes grandeurs
    533605      do iQ=1,nQ
    534          dQ(:,jjb:jje,:,iQ)=dQ(:,jjb:jje,:,iQ)/masse_cum(:,jjb:jje,:)
     606!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     607        DO l=1,llm
     608           dQ(:,jjb:jje,l,iQ)=dQ(:,jjb:jje,l,iQ)/masse_cum(:,jjb:jje,l)
     609        ENDDO
     610!$OMP ENDDO NOWAIT
    535611      enddo
    536612 
    … …  
    545621      if (pole_sud) jje=jj_end-1
    546622
    547       zv(jjb:jje,:)=0.
    548       zmasse(jjb:jje,:)=0.
     623!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     624        DO l=1,llm
     625          zv(jjb:jje,l)=0.
     626          zmasse(jjb:jje,l)=0.
     627        ENDDO
     628!$OMP ENDDO NOWAIT
    549629
    550630      call Register_Hallo(masse_cum,ip1jmp1,llm,1,1,1,1,Req)
    … …  
    554634
    555635      call SendRequest(Req)
     636!$OMP BARRIER
    556637      call WaitRequest(Req)
     638c$OMP BARRIER
    557639
    558640      call massbar_p(masse_cum,massebx,masseby)
    … …  
    562644      if (pole_sud) jje=jj_end-1
    563645     
     646!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    564647      do l=1,llm
    565648         do j=jjb,jje
    … …  
    571654         enddo
    572655      enddo
     656!$OMP ENDDO
    573657
    574658c     print*,'3OK'
    … …  
    609693      psiQ=0.
    610694      do iQ=1,nQ
    611          zvQtmp=0.
     695!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    612696         do l=1,llm
     697            zvQtmp(:,l)=0.
    613698            do j=jjb,jje
    614699c              print*,'j,l,iQ=',j,l,iQ
    … …  
    633718            enddo
    634719         enddo
     720!$OMP ENDDO NOWAIT
    635721c   fonction de courant meridienne pour la quantite Q
     722!$OMP BARRIER
     723!$OMP MASTER
    636724         do l=llm,1,-1
    637725            do j=jjb,jje
    … …  
    639727            enddo
    640728         enddo
    641       enddo
     729!$OMP END MASTER
     730!$OMP BARRIER
     731      enddo ! of do iQ=1,nQ
    642732
    643733c   fonction de courant pour la circulation meridienne moyenne
     734!$OMP BARRIER
     735!$OMP MASTER
    644736      psi(jjb:jje,:)=0.
    645737      do l=llm,1,-1
    … …  
    649741         enddo
    650742      enddo
     743!$OMP END MASTER
     744!$OMP BARRIER
    651745
    652746c     print*,'4OK'
    653747c   sorties proprement dites
     748!$OMP MASTER     
    654749      if (i_sortie.eq.1) then
    655750      jjb=jj_begin
    … …  
    669764     s                  ,jjn*llm,ndex3d)
    670765      enddo
    671 
    672766      call histwrite(fileid,'masse',itau,zmasse(jjb:jje,1:llm)
    673767     s   ,jjn*llm,ndex3d)
    … …  
    703797         enddo
    704798      enddo
    705 
     799!$OMP END MASTER
     800!$OMP BARRIER
    706801c     on doit pouvoir tracer systematiquement la fonction de courant.
    707802
    … …  
    712807c/////////////////////////////////////////////////////////////////////
    713808c=====================================================================
    714 
    715809      return
    716810      end
     811

  • trunk/LMDZ.COMMON/libf/dyn3dpar/conf_gcm.F

    r1189 r1300  
    1515      use mod_filtre_fft, ONLY : use_filtre_fft
    1616      use mod_hallo, ONLY : use_mpi_alloc
    17       use parallel_lmdz, ONLY : omp_chunk
    1817      USE control_mod
    1918      USE infotrac, ONLY : type_trac
    … …  
    587586      use_mpi_alloc=.FALSE.
    588587      CALL getin('use_mpi_alloc',use_mpi_alloc)
    589 
    590 !Config  Key  = omp_chunk
    591 !Config  Desc = taille des blocs openmp
    592 !Config  Def  = 1
    593 !Config  Help = defini la taille des packets d'iteration openmp
    594 !Config         distribuee a chaque tache lors de l'entree dans une
    595 !Config         boucle parallelisee
    596  
    597       omp_chunk=1
    598       CALL getin('omp_chunk',omp_chunk)
    599588
    600589!Config key = ok_strato
    … …  
    10161005      write(lunout,*)' use_filtre_fft = ', use_filtre_fft
    10171006      write(lunout,*)' use_mpi_alloc = ', use_mpi_alloc
    1018       write(lunout,*)' omp_chunk = ', omp_chunk
    10191007      write(lunout,*)' ok_strato = ', ok_strato
    10201008      write(lunout,*)' ok_gradsfile = ', ok_gradsfile

  • trunk/LMDZ.COMMON/libf/dyn3dpar/gcm.F

    r1107 r1300  
    1010#endif
    1111
    12 
    13 #ifdef CPP_XIOS
    14     ! ug Pour les sorties XIOS
    15         USE wxios
    16 #endif
    1712
    1813      USE mod_const_mpi, ONLY: init_const_mpi
    … …  
    193188c   Initialisation partie parallele
    194189c------------------------------------
     190
    195191      CALL init_const_mpi
    196 
    197192      call init_parallel
    198193      call ini_getparam("out.def")
    … …  
    225220!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    226221
    227 #ifdef CPP_XIOS
    228         CALL wxios_init("LMDZ")
    229 #endif
    230222
    231223c
    … …  
    362354          start_time = starttime
    363355        ELSE
    364           WRITE(lunout,*)'Je m''arrete'
    365           CALL abort
     356          call abort_gcm("gcm", "'Je m''arrete'", 1)
    366357        ENDIF
    367358      ENDIF

  • trunk/LMDZ.COMMON/libf/dyn3dpar/guide_p_mod.F90

    r1019 r1300  
    9191    CALL getpar('guide_teta',.false.,guide_teta,'guidage de T par Teta')
    9292
    93     CALL getpar('guide_add',.false.,guide_add,'for�age constant?')
     93    CALL getpar('guide_add',.false.,guide_add,'for�age constant?')
    9494    CALL getpar('guide_zon',.false.,guide_zon,'guidage moy zonale')
    9595
    … …  
    108108    CALL getpar('guide_BL',.true.,guide_BL,'guidage dans C.Lim')
    109109   
    110 ! Sauvegarde du for�age
     110! Sauvegarde du for�age
    111111    CALL getpar('guide_sav',.false.,guide_sav,'sauvegarde guidage')
    112112    CALL getpar('iguide_sav',4,iguide_sav,'freq. sauvegarde guidage')
    … …  
    155155    ncidpl=-99
    156156    if (guide_plevs.EQ.1) then
    157        if (ncidpl.eq.-99) rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl)
     157       if (ncidpl.eq.-99) then
     158          rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl)
     159          if (rcod.NE.NF_NOERR) THEN
     160             print *,'Guide: probleme -> pas de fichier apbp.nc'
     161             CALL abort_gcm(modname,abort_message,1)
     162          endif
     163       endif
    158164    elseif (guide_plevs.EQ.2) then
    159        if (ncidpl.EQ.-99) rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl)
     165       if (ncidpl.EQ.-99) then
     166          rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl)
     167          if (rcod.NE.NF_NOERR) THEN
     168             print *,'Guide: probleme -> pas de fichier P.nc'
     169             CALL abort_gcm(modname,abort_message,1)
     170          endif
     171       endif
    160172    elseif (guide_u) then
    161        if (ncidpl.eq.-99) rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
     173       if (ncidpl.eq.-99) then
     174          rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
     175          if (rcod.NE.NF_NOERR) THEN
     176             print *,'Guide: probleme -> pas de fichier u.nc'
     177             CALL abort_gcm(modname,abort_message,1)
     178          endif
     179       endif
    162180    elseif (guide_v) then
    163        if (ncidpl.eq.-99) rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
     181       if (ncidpl.eq.-99) then
     182          rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
     183          if (rcod.NE.NF_NOERR) THEN
     184             print *,'Guide: probleme -> pas de fichier v.nc'
     185             CALL abort_gcm(modname,abort_message,1)
     186          endif
     187       endif
    164188    elseif (guide_T) then
    165        if (ncidpl.eq.-99) rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
     189       if (ncidpl.eq.-99) then
     190          rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
     191          if (rcod.NE.NF_NOERR) THEN
     192             print *,'Guide: probleme -> pas de fichier T.nc'
     193             CALL abort_gcm(modname,abort_message,1)
     194          endif
     195       endif
    166196    elseif (guide_Q) then
    167        if (ncidpl.eq.-99) rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
     197       if (ncidpl.eq.-99) then
     198          rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
     199          if (rcod.NE.NF_NOERR) THEN
     200             print *,'Guide: probleme -> pas de fichier hur.nc'
     201             CALL abort_gcm(modname,abort_message,1)
     202          endif
     203       endif
    168204    endif
    169205    error=NF_INQ_DIMID(ncidpl,'LEVEL',rid)
    … …  
    292328!=======================================================================
    293329  SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps)
    294     use parallel_lmdz
     330    USE parallel_lmdz
    295331    USE control_mod
    296332   
    … …  
    12311267    INTEGER               :: status,rcode
    12321268
     1269    CHARACTER (len = 80)   :: abort_message
     1270    CHARACTER (len = 20)   :: modname = 'guide_read'
    12331271! -----------------------------------------------------------------
    12341272! Premier appel: initialisation de la lecture des fichiers
    … …  
    12411279             print *,'Lecture du guidage sur niveaux modele'
    12421280             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
     1281             IF (rcode.NE.NF_NOERR) THEN
     1282              print *,'Guide: probleme -> pas de fichier apbp.nc'
     1283              CALL abort_gcm(modname,abort_message,1)
     1284             ENDIF
    12431285             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
     1286             IF (rcode.NE.NF_NOERR) THEN
     1287              print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
     1288              CALL abort_gcm(modname,abort_message,1)
     1289             ENDIF
    12441290             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
     1291             IF (rcode.NE.NF_NOERR) THEN
     1292              print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
     1293              CALL abort_gcm(modname,abort_message,1)
     1294             ENDIF
    12451295             print*,'ncidpl,varidap',ncidpl,varidap
    12461296         endif
    … …  
    12481298         if (guide_plevs.EQ.2) then
    12491299             rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
     1300             IF (rcode.NE.NF_NOERR) THEN
     1301              print *,'Guide: probleme -> pas de fichier P.nc'
     1302              CALL abort_gcm(modname,abort_message,1)
     1303             ENDIF
    12501304             rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
     1305             IF (rcode.NE.NF_NOERR) THEN
     1306              print *,'Guide: probleme -> pas de variable PRES, fichier P.nc'
     1307              CALL abort_gcm(modname,abort_message,1)
     1308             ENDIF
    12511309             print*,'ncidp,varidp',ncidp,varidp
    12521310             if (ncidpl.eq.-99) ncidpl=ncidp
    … …  
    12551313         if (guide_u) then
    12561314             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
     1315             IF (rcode.NE.NF_NOERR) THEN
     1316              print *,'Guide: probleme -> pas de fichier u.nc'
     1317              CALL abort_gcm(modname,abort_message,1)
     1318             ENDIF
    12571319             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
     1320             IF (rcode.NE.NF_NOERR) THEN
     1321              print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
     1322              CALL abort_gcm(modname,abort_message,1)
     1323             ENDIF
    12581324             print*,'ncidu,varidu',ncidu,varidu
    12591325             if (ncidpl.eq.-99) ncidpl=ncidu
    … …  
    12621328         if (guide_v) then
    12631329             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
     1330             IF (rcode.NE.NF_NOERR) THEN
     1331              print *,'Guide: probleme -> pas de fichier v.nc'
     1332              CALL abort_gcm(modname,abort_message,1)
     1333             ENDIF
    12641334             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
     1335             IF (rcode.NE.NF_NOERR) THEN
     1336              print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
     1337              CALL abort_gcm(modname,abort_message,1)
     1338             ENDIF
    12651339             print*,'ncidv,varidv',ncidv,varidv
    12661340             if (ncidpl.eq.-99) ncidpl=ncidv
    … …  
    12691343         if (guide_T) then
    12701344             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
     1345             IF (rcode.NE.NF_NOERR) THEN
     1346              print *,'Guide: probleme -> pas de fichier T.nc'
     1347              CALL abort_gcm(modname,abort_message,1)
     1348             ENDIF
    12711349             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
     1350             IF (rcode.NE.NF_NOERR) THEN
     1351              print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
     1352              CALL abort_gcm(modname,abort_message,1)
     1353             ENDIF
    12721354             print*,'ncidT,varidT',ncidt,varidt
    12731355             if (ncidpl.eq.-99) ncidpl=ncidt
    … …  
    12761358         if (guide_Q) then
    12771359             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
     1360             IF (rcode.NE.NF_NOERR) THEN
     1361              print *,'Guide: probleme -> pas de fichier hur.nc'
     1362              CALL abort_gcm(modname,abort_message,1)
     1363             ENDIF
    12781364             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
     1365             IF (rcode.NE.NF_NOERR) THEN
     1366              print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
     1367              CALL abort_gcm(modname,abort_message,1)
     1368             ENDIF
    12791369             print*,'ncidQ,varidQ',ncidQ,varidQ
    12801370             if (ncidpl.eq.-99) ncidpl=ncidQ
    … …  
    12831373         if ((guide_P).OR.(guide_plevs.EQ.1)) then
    12841374             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
     1375             IF (rcode.NE.NF_NOERR) THEN
     1376              print *,'Guide: probleme -> pas de fichier ps.nc'
     1377              CALL abort_gcm(modname,abort_message,1)
     1378             ENDIF
    12851379             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
     1380             IF (rcode.NE.NF_NOERR) THEN
     1381              print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
     1382              CALL abort_gcm(modname,abort_message,1)
     1383             ENDIF
    12861384             print*,'ncidps,varidps',ncidps,varidps
    12871385         endif
    … …  
    14341532    INTEGER               :: i
    14351533
     1534    CHARACTER (len = 80)   :: abort_message
     1535    CHARACTER (len = 20)   :: modname = 'guide_read2D'
    14361536! -----------------------------------------------------------------
    14371537! Premier appel: initialisation de la lecture des fichiers
    … …  
    14421542! Ap et Bp si niveaux de pression hybrides
    14431543         if (guide_plevs.EQ.1) then
    1444              print *,'Lecture du guidage sur niveaux mod�le'
     1544             print *,'Lecture du guidage sur niveaux mod�le'
    14451545             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
     1546             IF (rcode.NE.NF_NOERR) THEN
     1547              print *,'Guide: probleme -> pas de fichier apbp.nc'
     1548              CALL abort_gcm(modname,abort_message,1)
     1549             ENDIF
    14461550             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
     1551             IF (rcode.NE.NF_NOERR) THEN
     1552              print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
     1553              CALL abort_gcm(modname,abort_message,1)
     1554             ENDIF
    14471555             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
     1556             IF (rcode.NE.NF_NOERR) THEN
     1557              print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
     1558              CALL abort_gcm(modname,abort_message,1)
     1559             ENDIF
    14481560             print*,'ncidpl,varidap',ncidpl,varidap
    14491561         endif
    … …  
    14511563         if (guide_plevs.EQ.2) then
    14521564             rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
     1565             IF (rcode.NE.NF_NOERR) THEN
     1566              print *,'Guide: probleme -> pas de fichier P.nc'
     1567              CALL abort_gcm(modname,abort_message,1)
     1568             ENDIF
    14531569             rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
     1570             IF (rcode.NE.NF_NOERR) THEN
     1571              print *,'Guide: probleme -> pas de variable PRES, fichier P.nc'
     1572              CALL abort_gcm(modname,abort_message,1)
     1573             ENDIF
    14541574             print*,'ncidp,varidp',ncidp,varidp
    14551575             if (ncidpl.eq.-99) ncidpl=ncidp
    … …  
    14581578         if (guide_u) then
    14591579             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
     1580             IF (rcode.NE.NF_NOERR) THEN
     1581              print *,'Guide: probleme -> pas de fichier u.nc'
     1582              CALL abort_gcm(modname,abort_message,1)
     1583             ENDIF
    14601584             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
     1585             IF (rcode.NE.NF_NOERR) THEN
     1586              print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
     1587              CALL abort_gcm(modname,abort_message,1)
     1588             ENDIF
    14611589             print*,'ncidu,varidu',ncidu,varidu
    14621590             if (ncidpl.eq.-99) ncidpl=ncidu
    … …  
    14651593         if (guide_v) then
    14661594             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
     1595             IF (rcode.NE.NF_NOERR) THEN
     1596              print *,'Guide: probleme -> pas de fichier v.nc'
     1597              CALL abort_gcm(modname,abort_message,1)
     1598             ENDIF
    14671599             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
     1600             IF (rcode.NE.NF_NOERR) THEN
     1601              print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
     1602              CALL abort_gcm(modname,abort_message,1)
     1603             ENDIF
    14681604             print*,'ncidv,varidv',ncidv,varidv
    14691605             if (ncidpl.eq.-99) ncidpl=ncidv
    … …  
    14721608         if (guide_T) then
    14731609             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
     1610             IF (rcode.NE.NF_NOERR) THEN
     1611              print *,'Guide: probleme -> pas de fichier T.nc'
     1612              CALL abort_gcm(modname,abort_message,1)
     1613             ENDIF
    14741614             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
     1615             IF (rcode.NE.NF_NOERR) THEN
     1616              print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
     1617              CALL abort_gcm(modname,abort_message,1)
     1618             ENDIF
    14751619             print*,'ncidT,varidT',ncidt,varidt
    14761620             if (ncidpl.eq.-99) ncidpl=ncidt
    … …  
    14791623         if (guide_Q) then
    14801624             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
     1625             IF (rcode.NE.NF_NOERR) THEN
     1626              print *,'Guide: probleme -> pas de fichier hur.nc'
     1627              CALL abort_gcm(modname,abort_message,1)
     1628             ENDIF
    14811629             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
     1630             IF (rcode.NE.NF_NOERR) THEN
     1631              print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
     1632              CALL abort_gcm(modname,abort_message,1)
     1633             ENDIF
    14821634             print*,'ncidQ,varidQ',ncidQ,varidQ
    14831635             if (ncidpl.eq.-99) ncidpl=ncidQ
    … …  
    14861638         if ((guide_P).OR.(guide_plevs.EQ.1)) then
    14871639             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
     1640             IF (rcode.NE.NF_NOERR) THEN
     1641              print *,'Guide: probleme -> pas de fichier ps.nc'
     1642              CALL abort_gcm(modname,abort_message,1)
     1643             ENDIF
    14881644             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
     1645             IF (rcode.NE.NF_NOERR) THEN
     1646              print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
     1647              CALL abort_gcm(modname,abort_message,1)
     1648             ENDIF
    14891649             print*,'ncidps,varidps',ncidps,varidps
    14901650         endif
    … …  
    17101870#endif
    17111871! --------------------------------------------------------------------
    1712 ! Cr�ation des variables sauvegard�es
     1872! Cr�ation des variables sauvegard�es
    17131873! --------------------------------------------------------------------
    17141874        ierr = NF_REDEF(nid)
    … …  
    18361996!===========================================================================
    18371997END MODULE guide_p_mod
     1998

  • trunk/LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F

    r1190 r1300  
    2929       use sponge_mod_p, only: callsponge,mode_sponge,sponge_p
    3030       use comuforc_h
    31 
    32 #ifdef CPP_XIOS
    33     ! ug Pour les sorties XIOS
    34         USE wxios
    35 #endif
    3631
    3732      IMPLICIT NONE
    … …  
    15451540c$OMP BARRIER
    15461541        RETURN
    1547       ENDIF
     1542      ENDIF ! of IF (itau==itaumax)
    15481543     
    15491544      IF ( .NOT.purmats ) THEN
    … …  
    15791574
    15801575c$OMP MASTER
    1581 
    1582 #ifdef CPP_XIOS
    1583     !Fermeture propre de XIOS
    1584       CALL wxios_close()
    1585 #endif
    15861576              call fin_getparam
    15871577              call finalize_parallel
    … …  
    16041594#ifdef CPP_IOIPSL
    16051595             IF (ok_dynzon) THEN
    1606              call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest)
    1607              call SendRequest(TestRequest)
    1608 c$OMP BARRIER
    1609               call WaitRequest(TestRequest)
    1610 c$OMP BARRIER
    1611 c$OMP MASTER
    1612 !              CALL writedynav_p(histaveid, itau,vcov ,
    1613 !     ,                          ucov,teta,pk,phi,q,masse,ps,phis)
    1614 
    1615 c ATTENTION!!! bilan_dyn_p ne marche probablement pas avec OpenMP
    1616 !              CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
    1617 !     ,             ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
     1596              CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
     1597     ,             ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
    16181598c les traceurs ne sont pas sortis, trop lourd.
    16191599c Peut changer eventuellement si besoin.
    1620                  CALL bilan_dyn_p(dtvr*iperiod,dtvr*day_step*periodav,
    1621      &                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,
    1622      &                 du,dudis,dutop,dufi)
    1623 c$OMP END MASTER
     1600!                 CALL bilan_dyn_p(dtvr*iperiod,dtvr*day_step*periodav,
     1601!     &                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,
     1602!     &                 du,dudis,dutop,dufi)
    16241603              ENDIF !ok_dynzon
    16251604#endif
    … …  
    18281807#ifdef CPP_IOIPSL
    18291808               IF (ok_dynzon) THEN
    1830 c$OMP BARRIER
    1831                call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest)
    1832                call SendRequest(TestRequest)
    1833 c$OMP BARRIER
    1834                call WaitRequest(TestRequest)
    1835 c$OMP BARRIER
    1836 c$OMP MASTER
    1837 !               CALL writedynav_p(histaveid, itau,vcov ,
    1838 !     ,                          ucov,teta,pk,phi,q,masse,ps,phis)
    1839 !               CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
    1840 !     ,           ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
     1809               CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
     1810     ,           ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
    18411811c les traceurs ne sont pas sortis, trop lourd.
    18421812c Peut changer eventuellement si besoin.
    1843                  CALL bilan_dyn_p(dtvr*iperiod,dtvr*day_step*periodav,
    1844      &                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,
    1845      &                 du,dudis,dutop,dufi)
    1846 
    1847 c$OMP END MASTER
     1813!                 CALL bilan_dyn_p(dtvr*iperiod,dtvr*day_step*periodav,
     1814!     &                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,
     1815!     &                 du,dudis,dutop,dufi)
    18481816               END IF !ok_dynzon
    18491817#endif

  • trunk/LMDZ.COMMON/libf/dyn3dpar/mod_const_mpi.F90

    r979 r1300  
    33!
    44MODULE mod_const_mpi
    5 
     5  IMPLICIT NONE
    66  INTEGER,SAVE :: COMM_LMDZ
    77  INTEGER,SAVE :: MPI_REAL_LMDZ
    … …  
    1212  SUBROUTINE Init_const_mpi
    1313#ifdef CPP_IOIPSL
    14     USE IOIPSL
     14    USE IOIPSL, ONLY: getin
    1515#else
    1616! if not using IOIPSL, we still need to use (a local version of) getin
    17     USE ioipsl_getincom
     17    USE ioipsl_getincom, only: getin
    1818#endif
    1919
    … …  
    2222    INCLUDE 'mpif.h'
    2323#endif
     24
    2425    INTEGER             :: ierr
    2526    INTEGER             :: comp_id
    … …  
    5152 
    5253  SUBROUTINE Init_mpi
     54#ifdef CPP_XIOS
     55    USE wxios, only: wxios_init
     56#endif
    5357  IMPLICIT NONE
    5458#ifdef CPP_MPI
    … …  
    7074      COMM_LMDZ=MPI_COMM_WORLD
    7175      MPI_REAL_LMDZ=MPI_REAL8
     76!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     77! Initialisation de XIOS
     78!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     79#ifdef CPP_XIOS
     80      CALL wxios_init("LMDZ", outcom=COMM_LMDZ)
     81#endif
    7282!$OMP END MASTER
     83#else
     84#ifdef CPP_XIOS
     85!$OMP MASTER
     86      CALL wxios_init("LMDZ")
     87!$OMP END MASTER
     88#endif
    7389#endif
    7490
    … …  
    7692   
    7793END MODULE mod_const_mpi
     94

  • trunk/LMDZ.COMMON/libf/dyn3dpar/parallel_lmdz.F90

    r1019 r1300  
    44  module parallel_lmdz
    55  USE mod_const_mpi
     6#ifdef CPP_IOIPSL
     7      use IOIPSL, only: getin
     8#else
     9! if not using IOIPSL, we still need to use (a local version of) getin
     10      use ioipsl_getincom, only: getin
     11#endif   
    612   
    713    LOGICAL,SAVE :: using_mpi=.TRUE.
    … …  
    155161        omp_size=OMP_GET_NUM_THREADS()
    156162!$OMP END MASTER
     163!$OMP BARRIER
    157164        omp_rank=OMP_GET_THREAD_NUM()   
     165
     166!Config  Key  = omp_chunk
     167!Config  Desc = taille des blocs openmp
     168!Config  Def  = 1
     169!Config  Help = defini la taille des packets d'it�ration openmp
     170!Config         distribue a chaque tache lors de l'entree dans une
     171!Config         boucle parallelisee
     172
     173!$OMP MASTER
     174      omp_chunk=(llm+1)/omp_size
     175      IF (MOD(llm+1,omp_size)/=0) omp_chunk=omp_chunk+1
     176      CALL getin('omp_chunk',omp_chunk)
     177!$OMP END MASTER
     178!$OMP BARRIER       
    158179#else   
    159180        omp_size=1
    … …  
    199220   
    200221    subroutine Finalize_parallel
     222#ifdef CPP_XIOS
     223    ! ug Pour les sorties XIOS
     224        USE wxios
     225#endif
    201226#ifdef CPP_COUPLE
    202227    use mod_prism_proto
    … …  
    234259#endif
    235260      else
     261#ifdef CPP_XIOS
     262    !Fermeture propre de XIOS
     263      CALL wxios_close()
     264#endif
    236265#ifdef CPP_MPI
    237266         IF (using_mpi) call MPI_FINALIZE(ierr)

  • trunk/LMDZ.COMMON/makelmdz

    r1107 r1300  
    2525fcm_path=none
    2626cosp=false
     27sisvat=false
    2728bands=""
    2829scatterers=""
    … …  
    3839  arch="SX8_BRODIE"
    3940fi
    40 if [[ "${machine:0:6}" == "vargas" ]]
    41 then
    42   arch="PW6_VARGAS"
    43 fi
    44 if [[ "${machine:0:6}" == "ada338" ]]
    45 then
    46   arch="PW6_VARGAS"
     41if [[ "${machine:0:3}" == "ada" ]]
     42then
     43  arch="X64_ADA"
    4744fi
    4845if [[ "${machine:0:6}" == "ciclad" ]]
    … …  
    9087
    9188CPP_KEY=""
    92 INCLUDE='-I$(LIBF)/grid -I$(LIBF)/bibio -I$(LIBF)/filtrez -I. '
     89INCLUDE='-I$(LIBF)/grid -I$(LIBF)/bibio -I$(LIBF)/dyn3d_common -I$(LIBF)/filtrez -I. '
    9390LIB=""
    9491adjnt=""
    … …  
    195192          cosp="$2" ; shift ; shift ;;
    196193     
     194      "-sisvat")
     195          sisvat="$2" ; shift ; shift ;;
     196     
    197197      "-mem")
    198198          paramem="mem" ; shift ;;
    … …  
    434434   INCLUDE="$INCLUDE -I${IOIPSL_INCDIR}"
    435435   LIB="$LIB -L${IOIPSL_LIBDIR} -l${LIBPREFIX}ioipsl"
     436elif [[ $io == xios ]]
     437then
     438   # For now, xios implies also using ioipsl
     439   CPP_KEY="$CPP_KEY CPP_IOIPSL CPP_XIOS"
     440   INCLUDE="$INCLUDE -I${IOIPSL_INCDIR} -I${XIOS_INCDIR}"
     441   LIB="$LIB -L${IOIPSL_LIBDIR} -l${LIBPREFIX}ioipsl -L${XIOS_LIBDIR} -l${LIBPREFIX}stdc++ -l${LIBPREFIX}xios"
    436442fi
    437443
    … …  
    444450   lcosp="-l${LIBPREFIX}cosp"
    445451   INCLUDE="$INCLUDE"' -I$(LIBF)/cosp'
     452fi
     453
     454if [[ "$sisvat" == "true" ]]
     455then
     456   CPP_KEY="$CPP_KEY CPP_SISVAT"
    446457fi
    447458

  • trunk/LMDZ.COMMON/makelmdz_fcm

    r1107 r1300  
    2222couple=false
    2323veget=false
     24sisvat=false
    2425chimie=false
    2526chemistry=false
    … …  
    134135          veget="$2" ; shift ; shift ;;
    135136
     137      "-sisvat")
     138          sisvat="$2" ; shift ; shift ;;
     139
    136140      "-chimie")
    137141          chimie="$2" ; shift ; shift ;;
    … …  
    287291   fi
    288292   if [[ "$veget" == "orchidee2.0" ]] ; then
    289       orch_libs=orchidee
     293      orch_libs="sechiba parameters stomate parallel orglob orchidee"
    290294   else
    291295      orch_libs="sechiba parameters stomate parallel orglob"
    … …  
    303307fi
    304308
     309if [[ "$sisvat" == "true" ]]
     310then
     311   CPP_KEY="$CPP_KEY CPP_SISVAT"
     312   sed -e 's/^#src::sisvat/src::sisvat/' bld.cfg > bld.tmp
     313   mv bld.tmp bld.cfg
     314fi
     315
    305316if [[ $io == ioipsl ]]
    306317then
    … …  
    308319   INCLUDE="$INCLUDE -I${IOIPSL_INCDIR}"
    309320   LIB="$LIB -L${IOIPSL_LIBDIR} -l${LIBPREFIX}ioipsl"
     321elif [[ $io == xios ]]
     322then
     323   # For now, xios implies also using ioipsl
     324   CPP_KEY="$CPP_KEY CPP_IOIPSL CPP_XIOS"
     325   INCLUDE="$INCLUDE -I${IOIPSL_INCDIR} -I${XIOS_INCDIR}"
     326   LIB="$LIB -L${IOIPSL_LIBDIR} -l${LIBPREFIX}ioipsl -L${XIOS_LIBDIR} -l${LIBPREFIX}stdc++ -l${LIBPREFIX}xios"
    310327fi
    311328
    … …  
    549566ln -s $LIBOGCM/${arch}${SUFF_NAME}/.config/tmp tmp_src
    550567
     568#eventual cleanup for SISVAT
     569sed -e 's/^src::sisvat/#src::sisvat/' bld.cfg > bld.tmp
     570mv bld.tmp bld.cfg
     571
     572
    551573if [[ -r $LIBFGCM/grid/dimensions.h ]]
    552574then
Note: See TracChangeset for help on using the changeset viewer.