New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 9079 for branches/2017/dev_merge_2017/NEMOGCM – NEMO

Ignore:
Timestamp:
2017-12-15T15:43:43+01:00 (6 years ago)
Author:
flavoni
Message:

update DOMAINcfg TOOLS, do not need xios anymore

Location:
branches/2017/dev_merge_2017/NEMOGCM/TOOLS/DOMAINcfg
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • branches/2017/dev_merge_2017/NEMOGCM/TOOLS/DOMAINcfg/README

    r7828 r9079  
    2222= HOW TO USE 
    2323================================ 
    24 ::: VERY IMPORTANT PRE-REQUIRED ::: 
    25 0) pre-required: this tool needs xios1 
    26  
    27   (download http://forge.ipsl.jussieu.fr/ioserver/svn/XIOS/branchs/xios-1.0 
    28    DOMAINcfg tool is working with revision 703 of xios) 
    29  
    30241) copy in DOMAINcfg  directory namelist_cfg all settings (that you had in 3.6_stable) of the configuration for which you want prepare domain_cfg.nc file 
    31 IMPORTANT : keep the namelist_ref committed inchanged.  
     25IMPORTANT : keep the namelist_ref committed inchanged. !!! 
    3226 
    3327NEW OPTION ln_e3_dep in the namelist_ref: 

  • branches/2017/dev_merge_2017/NEMOGCM/TOOLS/DOMAINcfg/src/domwri.f90

    r6984 r9079  
    2222   USE wrk_nemo        ! Memory allocation 
    2323   USE timing          ! Timing 
     24   USE phycst 
    2425 
    2526   IMPLICIT NONE 

  • branches/2017/dev_merge_2017/NEMOGCM/TOOLS/DOMAINcfg/src/in_out_manager.f90

    r6951 r9079  
    132132   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. ln_ctl 
    133133   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area 
    134    CHARACTER(lc) ::   cxios_context         !: context name used in xios 
    135134 
    136135   !!---------------------------------------------------------------------- 

  • branches/2017/dev_merge_2017/NEMOGCM/TOOLS/DOMAINcfg/src/iom.f90

    r6951 r9079  
    88   !!            3.0  ! 2007-07  (D. Storkey) Changes to iom_gettime 
    99   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case   
    10    !!            3.6  ! 2014-15  DIMG format removed 
    1110   !!-------------------------------------------------------------------- 
    1211 
    … …  
    2423   USE iom_nf90        ! NetCDF format with native NetCDF library 
    2524   USE in_out_manager  ! I/O manager 
    26    USE lib_mpp         ! MPP library 
    27    USE domngb          ! ocean space and time domain 
    28    USE phycst          ! physical constants 
    29    USE xios 
    30    USE ioipsl, ONLY :  ju2ymds    ! for calendar 
     25   USE lib_mpp           ! MPP library 
    3126 
    3227   IMPLICIT NONE 
    3328   PUBLIC   !   must be public to be able to access iom_def through iom 
    3429    
    35  
    36    LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .TRUE.        !: iom_put flag 
    37  
    38  
    39  
     30   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag 
    4031   PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 
    4132   PUBLIC iom_getatt, iom_use, iom_context_finalize 
    … …  
    4435   PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d 
    4536   PRIVATE iom_p1d, iom_p2d, iom_p3d 
    46  
    47    PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 
    48    PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 
    49  
    5037 
    5138   INTERFACE iom_get 
    … …  
    6451   !!---------------------------------------------------------------------- 
    6552   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    66    !! $Id: iom.F90 6519 2016-05-11 10:50:34Z timgraham $ 
     53   !! $Id: iom.F90 8572 2017-09-28 08:27:06Z cbricaud $ 
    6754   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6855   !!---------------------------------------------------------------------- 
    … …  
    7865      !!---------------------------------------------------------------------- 
    7966      CHARACTER(len=*), INTENT(in)  :: cdname 
    80  
    81       TYPE(xios_time)   :: dtime    = xios_time(0, 0, 0, 0, 0, 0) 
    82       CHARACTER(len=19) :: cldate  
    83       CHARACTER(len=10) :: clname 
    84       INTEGER           ::   ji 
    85       ! 
    86       REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 
    87       !!---------------------------------------------------------------------- 
    88  
    89       ALLOCATE( z_bnds(jpk,2) ) 
    90  
    91       clname = cdname 
    92       IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname) 
    93       CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 
    94       CALL iom_swap( cdname ) 
    95  
    96       ! calendar parameters 
    97       SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    98       CASE ( 1)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian") 
    99       CASE ( 0)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "NoLeap") 
    100       CASE (30)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "D360") 
    101       END SELECT 
    102       WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':',i2.2,':00')") nyear,nmonth,nday,nhour,nminute 
    103       CALL xios_set_context_attr(TRIM(clname), start_date=cldate ) 
    104  
    105       ! horizontal grid definition 
    106       CALL set_scalar 
    107  
    108       IF( TRIM(cdname) == TRIM(cxios_context) ) THEN   
    109          CALL set_grid( "T", glamt, gphit )  
    110          CALL set_grid( "U", glamu, gphiu ) 
    111          CALL set_grid( "V", glamv, gphiv ) 
    112          CALL set_grid( "W", glamt, gphit ) 
    113          CALL set_grid_znl( gphit ) 
    114          ! 
    115          IF( ln_cfmeta ) THEN   ! Add additional grid metadata 
    116             CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej)) 
    117             CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej)) 
    118             CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej)) 
    119             CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej)) 
    120             CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 
    121             CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 
    122             CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv ) 
    123             CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit ) 
    124          ENDIF 
    125       ENDIF 
    126  
    127       ! vertical grid definition 
    128       CALL iom_set_axis_attr( "deptht", gdept_1d ) 
    129       CALL iom_set_axis_attr( "depthu", gdept_1d ) 
    130       CALL iom_set_axis_attr( "depthv", gdept_1d ) 
    131       CALL iom_set_axis_attr( "depthw", gdepw_1d ) 
    132  
    133       ! Add vertical grid bounds 
    134       z_bnds(:      ,1) = gdepw_1d(:) 
    135       z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 
    136       z_bnds(jpk:   ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 
    137       CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 
    138       CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 
    139       CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 
    140       z_bnds(:    ,2) = gdept_1d(:) 
    141       z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 
    142       z_bnds(1    ,1) = gdept_1d(1) - e3w_1d(1) 
    143       CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 
    144  
    145       CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 
    146       CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) 
    147        
    148       ! automatic definitions of some of the xml attributs 
    149       CALL set_xmlatt 
    150  
    151       ! end file definition 
    152       dtime%second = rdt 
    153       CALL xios_set_timestep(dtime) 
    154       CALL xios_close_context_definition() 
    155        
    156       CALL xios_update_calendar(0) 
    157  
    158       DEALLOCATE( z_bnds ) 
    159  
    160  
    16167       
    16268   END SUBROUTINE iom_init 
    … …  
    17076      !!--------------------------------------------------------------------- 
    17177      CHARACTER(len=*), INTENT(in) :: cdname 
    172  
    173       TYPE(xios_context) :: nemo_hdl 
    174  
    175       IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
    176         CALL xios_get_handle(TRIM(cdname),nemo_hdl) 
    177       ELSE 
    178         CALL xios_get_handle(TRIM(Agrif_CFixed())//"_"//TRIM(cdname),nemo_hdl) 
    179       ENDIF 
    180       ! 
    181       CALL xios_set_current_context(nemo_hdl) 
    182  
    18378      ! 
    18479   END SUBROUTINE iom_swap 
    … …  
    20196      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu] 
    20297      CHARACTER(LEN=256)    ::   cltmpn    ! tempory name to store clname (in writting mode) 
    203       CHARACTER(LEN=10)     ::   clsuffix  ! ".nc"  
     98      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" or ".dimg" 
    20499      CHARACTER(LEN=15)     ::   clcpu     ! the cpu number (max jpmax_digits digits) 
    205100      CHARACTER(LEN=256)    ::   clinfo    ! info character 
    … …  
    266161      CASE (jpnf90   ) ;   clsuffix = '.nc' 
    267162      CASE DEFAULT     ;   clsuffix = '' 
    268          CALL ctl_stop( TRIM(clinfo), 'accepted IO library is only jpnf90 (jpioipsl option has been removed) ' ) 
    269163      END SELECT 
    270164      ! Add the suffix if needed 
    … …  
    279173      IF( .NOT.llok ) THEN 
    280174         ! we try to add the cpu number to the name 
    281          WRITE(clcpu,*) narea-1 
    282  
     175            WRITE(clcpu,*) narea-1 
    283176         clcpu  = TRIM(ADJUSTL(clcpu)) 
    284177         iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.) 
    … …  
    327220         END SELECT 
    328221      ENDIF 
    329       ! Open the NetCDF file 
     222      ! Open the NetCDF or RSTDIMG file 
    330223      ! ============= 
    331224      ! do we have some free file identifier? 
    … …  
    353246         CASE (jpnf90   )   ;   CALL iom_nf90_open(    clname, kiomid, llwrt, llok, idompar ) 
    354247         CASE DEFAULT 
    355             CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed) ' ) 
    356248         END SELECT 
    357249      ENDIF 
    … …  
    390282               CASE (jpnf90   )   ;   CALL iom_nf90_close(    jf ) 
    391283               CASE DEFAULT 
    392                   CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 
    393284               END SELECT 
    394285               iom_file(jf)%nfid       = 0          ! free the id  
    … …  
    446337                  SELECT CASE (iom_file(kiomid)%iolib) 
    447338                  CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz, kndims ) 
    448                   CASE DEFAULT 
    449                      CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 
     339                  CASE DEFAULT    
    450340                  END SELECT 
    451341               ELSE 
    … …  
    506396            SELECT CASE (iom_file(kiomid)%iolib) 
    507397            CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, pvar, itime ) 
    508             CASE DEFAULT 
    509                CALL ctl_stop( 'iom_g0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 
     398            CASE DEFAULT     
    510399            END SELECT 
    511400         ENDIF 
    … …  
    617506      CHARACTER(LEN=256)             ::   clname      ! file name 
    618507      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      !  
    619       LOGICAL                        ::   ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 
    620508      !--------------------------------------------------------------------- 
    621509      ! 
    … …  
    630518      IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 
    631519      IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 
    632       IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND.  idom /= jpdom_autoglo_xy  ) & 
    633      &           CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 
     520      IF( PRESENT(kstart) .AND. idom /= jpdom_unknown   ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown') 
    634521 
    635522      luse_jattr = .false. 
    … …  
    643530             ! Ok 
    644531         CASE DEFAULT     
    645             CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 
    646532         END SELECT 
    647533      ENDIF 
    … …  
    661547         ! update idom definition... 
    662548         ! Identify the domain in case of jpdom_auto(glo/dta) definition 
    663          IF( idom == jpdom_autoglo_xy ) THEN 
    664             ll_depth_spec = .TRUE. 
    665             idom = jpdom_autoglo 
    666          ELSE 
    667             ll_depth_spec = .FALSE. 
    668          ENDIF 
    669549         IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN             
    670550            IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global  
    … …  
    720600         istart(idmspc+1) = itime 
    721601 
    722          IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc) 
     602         IF(              PRESENT(kstart)      ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc) 
    723603         ELSE 
    724             IF(           idom == jpdom_unknown ) THEN                                                ; icnt(1:idmspc) = idimsz(1:idmspc) 
     604            IF(           idom == jpdom_unknown ) THEN                                       ; icnt(1:idmspc) = idimsz(1:idmspc) 
    725605            ELSE  
    726606               IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array 
    … …  
    745625                  ENDIF 
    746626                  IF( PRESENT(pv_r3d) ) THEN 
    747                      IF( idom == jpdom_data ) THEN                                  ; icnt(3) = jpkdta 
    748                      ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN            ; istart(3) = kstart(3); icnt(3) = kcount(3) 
    749                      ELSE                                                           ; icnt(3) = jpk 
     627                     IF( idom == jpdom_data ) THEN   ; icnt(3) = jpkdta 
     628                     ELSE                            ; icnt(3) = jpk 
    750629                     ENDIF 
    751630                  ENDIF 
    … …  
    818697         CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   & 
    819698            &                                         pv_r1d, pv_r2d, pv_r3d ) 
    820          CASE DEFAULT 
    821             CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 
     699         CASE DEFAULT     
    822700         END SELECT 
    823701 
    … …  
    845723               IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs 
    846724            ELSEIF( PRESENT(pv_r2d) ) THEN 
     725!CDIR COLLAPSE 
    847726               IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf 
     727!CDIR COLLAPSE 
    848728               IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs 
    849729            ELSEIF( PRESENT(pv_r3d) ) THEN 
     730!CDIR COLLAPSE 
    850731               IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 
     732!CDIR COLLAPSE 
    851733               IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 
    852734            ENDIF 
    … …  
    899781                     SELECT CASE (iom_file(kiomid)%iolib) 
    900782                     CASE (jpnf90   )   ;   CALL iom_nf90_gettime(   kiomid, idvar, ptime, cdunits, cdcalendar ) 
    901                      CASE DEFAULT 
    902                         CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 
     783                     CASE DEFAULT     
    903784                     END SELECT 
    904785                  ELSE 
    … …  
    932813            SELECT CASE (iom_file(kiomid)%iolib) 
    933814            CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pvar ) 
    934             CASE DEFAULT 
    935                CALL ctl_stop( 'iom_g0d_att: accepted IO library is only jpnf90' ) 
     815            CASE DEFAULT     
    936816            END SELECT 
    937817         ENDIF 
    … …  
    956836            SELECT CASE (iom_file(kiomid)%iolib) 
    957837            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 
    958             CASE DEFAULT 
    959                CALL ctl_stop( 'iom_rp0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 
     838            CASE DEFAULT      
    960839            END SELECT 
    961840         ENDIF 
    … …  
    976855            SELECT CASE (iom_file(kiomid)%iolib) 
    977856            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 
    978             CASE DEFAULT 
    979                CALL ctl_stop( 'iom_rp1d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 
     857            CASE DEFAULT      
    980858            END SELECT 
    981859         ENDIF 
    … …  
    996874            SELECT CASE (iom_file(kiomid)%iolib) 
    997875            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 
    998             CASE DEFAULT 
    999                CALL ctl_stop( 'iom_rp2d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 
     876            CASE DEFAULT      
    1000877            END SELECT 
    1001878         ENDIF 
    … …  
    1016893            SELECT CASE (iom_file(kiomid)%iolib) 
    1017894            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 
    1018             CASE DEFAULT 
    1019                CALL ctl_stop( 'iom_rp3d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 
     895            CASE DEFAULT      
    1020896            END SELECT 
    1021897         ENDIF 
    … …  
    1031907      REAL(wp)        , INTENT(in) ::   pfield0d 
    1032908      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson 
    1033  
    1034       zz(:,:)=pfield0d 
    1035       CALL xios_send_field(cdname, zz) 
    1036       !CALL xios_send_field(cdname, (/pfield0d/))  
    1037  
    1038  
    1039  
     909      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
    1040910   END SUBROUTINE iom_p0d 
    1041911 
    … …  
    1043913      CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
    1044914      REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d 
    1045  
    1046       CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) 
    1047  
    1048  
    1049  
     915      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings 
    1050916   END SUBROUTINE iom_p1d 
    1051917 
    … …  
    1053919      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
    1054920      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
    1055  
    1056       CALL xios_send_field(cdname, pfield2d) 
    1057  
    1058  
    1059  
     921      IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings 
    1060922   END SUBROUTINE iom_p2d 
    1061923 
    … …  
    1063925      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    1064926      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
    1065  
    1066       CALL xios_send_field(cdname, pfield3d) 
    1067  
    1068  
    1069  
     927      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings 
    1070928   END SUBROUTINE iom_p3d 
    1071929   !!---------------------------------------------------------------------- 
    … …  
    1073931 
    1074932 
    1075    SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj,   & 
    1076       &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask,     & 
    1077       &                                    nvertex, bounds_lon, bounds_lat, area ) 
    1078       CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
    1079       INTEGER                  , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj 
    1080       INTEGER                  , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
    1081       INTEGER                  , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 
    1082       REAL(wp), DIMENSION(:)   , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
    1083       REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area 
    1084       LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask 
    1085  
    1086       IF ( xios_is_valid_domain     (cdid) ) THEN 
    1087          CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    1088             &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
    1089             &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       & 
    1090             &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  & 
    1091             &    bounds_lat=bounds_lat, area=area ) 
    1092       ENDIF 
    1093  
    1094       IF ( xios_is_valid_domaingroup(cdid) ) THEN 
    1095          CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    1096             &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
    1097             &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       & 
    1098             &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  & 
    1099             &    bounds_lat=bounds_lat, area=area ) 
    1100       ENDIF 
    1101       CALL xios_solve_inheritance() 
    1102  
    1103    END SUBROUTINE iom_set_domain_attr 
    1104  
    1105  
    1106    SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds ) 
    1107       CHARACTER(LEN=*)      , INTENT(in) ::   cdid 
    1108       REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   paxis 
    1109       REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds 
    1110       IF ( PRESENT(paxis) ) THEN 
    1111          IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, size=SIZE(paxis), value=paxis ) 
    1112          IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis ) 
    1113       ENDIF 
    1114       IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds ) 
    1115       IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 
    1116       CALL xios_solve_inheritance() 
    1117    END SUBROUTINE iom_set_axis_attr 
    1118  
    1119  
    1120    SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 
    1121       CHARACTER(LEN=*)          , INTENT(in) ::   cdid 
    1122       CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_op 
    1123       CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_offset 
    1124       IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr       & 
    1125     &     ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
    1126       IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr  & 
    1127     &                    ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
    1128       CALL xios_solve_inheritance() 
    1129    END SUBROUTINE iom_set_field_attr 
    1130  
    1131  
    1132    SUBROUTINE iom_set_file_attr( cdid, name, name_suffix ) 
    1133       CHARACTER(LEN=*)          , INTENT(in) ::   cdid 
    1134       CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   name, name_suffix 
    1135       IF ( xios_is_valid_file     (cdid) )   CALL xios_set_file_attr     ( cdid, name=name, name_suffix=name_suffix ) 
    1136       IF ( xios_is_valid_filegroup(cdid) )   CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix ) 
    1137       CALL xios_solve_inheritance() 
    1138    END SUBROUTINE iom_set_file_attr 
    1139  
    1140  
    1141    SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 
    1142       CHARACTER(LEN=*)          , INTENT(in ) ::   cdid 
    1143       CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix, output_freq 
    1144       LOGICAL                                 ::   llexist1,llexist2,llexist3 
    1145       !--------------------------------------------------------------------- 
    1146       IF( PRESENT( name        ) )   name = ''          ! default values 
    1147       IF( PRESENT( name_suffix ) )   name_suffix = '' 
    1148       IF( PRESENT( output_freq ) )   output_freq = '' 
    1149       IF ( xios_is_valid_file     (cdid) ) THEN 
    1150          CALL xios_solve_inheritance() 
    1151          CALL xios_is_defined_file_attr     ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) 
    1152          IF(llexist1)   CALL xios_get_file_attr     ( cdid, name = name ) 
    1153          IF(llexist2)   CALL xios_get_file_attr     ( cdid, name_suffix = name_suffix ) 
    1154          IF(llexist3)   CALL xios_get_file_attr     ( cdid, output_freq = output_freq ) 
    1155       ENDIF 
    1156       IF ( xios_is_valid_filegroup(cdid) ) THEN 
    1157          CALL xios_solve_inheritance() 
    1158          CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) 
    1159          IF(llexist1)   CALL xios_get_filegroup_attr( cdid, name = name ) 
    1160          IF(llexist2)   CALL xios_get_filegroup_attr( cdid, name_suffix = name_suffix ) 
    1161          IF(llexist3)   CALL xios_get_filegroup_attr( cdid, output_freq = output_freq ) 
    1162       ENDIF 
    1163    END SUBROUTINE iom_get_file_attr 
    1164  
    1165  
    1166    SUBROUTINE iom_set_grid_attr( cdid, mask ) 
    1167       CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
    1168       LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask 
    1169       IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask=mask ) 
    1170       IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask=mask ) 
    1171       CALL xios_solve_inheritance() 
    1172    END SUBROUTINE iom_set_grid_attr 
    1173  
    1174933   SUBROUTINE iom_setkt( kt, cdname ) 
    1175       INTEGER         , INTENT(in) ::   kt  
     934      INTEGER         , INTENT(in)::   kt  
    1176935      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    1177       !      
    1178       CALL iom_swap( cdname )   ! swap to cdname context 
    1179       CALL xios_update_calendar(kt) 
    1180       IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context 
    1181       ! 
     936      IF( .FALSE. )   WRITE(numout,*) kt, cdname   ! useless test to avoid compilation warnings 
    1182937   END SUBROUTINE iom_setkt 
    1183938 
    1184939   SUBROUTINE iom_context_finalize( cdname ) 
    1185       CHARACTER(LEN=*), INTENT(in) :: cdname 
    1186       ! 
    1187       IF( xios_is_valid_context(cdname) ) THEN 
    1188          CALL iom_swap( cdname )   ! swap to cdname context 
    1189          CALL xios_context_finalize() ! finalize the context 
    1190          IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context 
    1191       ENDIF 
    1192       ! 
     940      CHARACTER(LEN=*), INTENT(in) ::   cdname 
     941      IF( .FALSE. )   WRITE(numout,*)  cdname   ! useless test to avoid compilation warnings 
    1193942   END SUBROUTINE iom_context_finalize 
    1194  
    1195  
    1196    SUBROUTINE set_grid( cdgrd, plon, plat ) 
    1197       !!---------------------------------------------------------------------- 
    1198       !!                     ***  ROUTINE set_grid  *** 
    1199       !! 
    1200       !! ** Purpose :   define horizontal grids 
    1201       !! 
    1202       !!---------------------------------------------------------------------- 
    1203       CHARACTER(LEN=1)            , INTENT(in) ::   cdgrd 
    1204       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plon 
    1205       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
    1206       ! 
    1207       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask 
    1208       INTEGER  :: ni,nj 
    1209        
    1210       ni=nlei-nldi+1 ; nj=nlej-nldj+1 
    1211  
    1212       CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 
    1213       CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    1214       CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   & 
    1215          &                                     latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
    1216  
    1217       IF ( ln_mskland ) THEN 
    1218          ! mask land points, keep values on coast line -> specific mask for U, V and W points 
    1219          SELECT CASE ( cdgrd ) 
    1220          CASE('T')   ;   zmask(:,:,:)       = tmask(:,:,:) 
    1221          CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( zmask, 'U', 1. ) 
    1222          CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( zmask, 'V', 1. ) 
    1223          CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1) 
    1224          END SELECT 
    1225          ! 
    1226          CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni,nj    /)) /= 0. ) 
    1227          CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. ) 
    1228       ENDIF 
    1229        
    1230    END SUBROUTINE set_grid 
    1231  
    1232  
    1233    SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt ) 
    1234       !!---------------------------------------------------------------------- 
    1235       !!                   ***  ROUTINE set_grid_bounds  *** 
    1236       !! 
    1237       !! ** Purpose :   define horizontal grid corners 
    1238       !! 
    1239       !!---------------------------------------------------------------------- 
    1240       CHARACTER(LEN=1) , INTENT(in) :: cdgrd 
    1241       ! 
    1242       REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           :: plon_cnr, plat_cnr  ! Lat/lon coordinates of a contiguous vertex of cell (i,j) 
    1243       REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coordinates of the point of cell (i,j) 
    1244       ! 
    1245       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)   :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j) 
    1246       REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_fld       ! Working array to determine where to rotate cells 
    1247       REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_rot       ! Lat/lon working array for rotation of cells 
    1248       ! 
    1249       INTEGER :: icnr, jcnr                                      ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
    1250       !                                                          ! represents the bottom-left corner of cell (i,j) 
    1251       INTEGER :: ji, jj, jn, ni, nj 
    1252  
    1253       ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2)  ) 
    1254  
    1255       ! Offset of coordinate representing bottom-left corner 
    1256       SELECT CASE ( TRIM(cdgrd) ) 
    1257          CASE ('T', 'W') 
    1258             icnr = -1 ; jcnr = -1 
    1259          CASE ('U') 
    1260             icnr =  0 ; jcnr = -1 
    1261          CASE ('V') 
    1262             icnr = -1 ; jcnr =  0 
    1263       END SELECT 
    1264  
    1265       ni = nlei-nldi+1 ; nj = nlej-nldj+1  ! Dimensions of subdomain interior 
    1266  
    1267       z_fld(:,:) = 1._wp 
    1268       CALL lbc_lnk( z_fld, cdgrd, -1. )    ! Working array for location of northfold 
    1269  
    1270       ! Cell vertices that can be defined 
    1271       DO jj = 2, jpjm1 
    1272          DO ji = 2, jpim1 
    1273             z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
    1274             z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
    1275             z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
    1276             z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
    1277             z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
    1278             z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
    1279             z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
    1280             z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
    1281          END DO 
    1282       END DO 
    1283  
    1284       ! Cell vertices on boundries 
    1285       DO jn = 1, 4 
    1286          CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp ) 
    1287          CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 
    1288       END DO 
    1289  
    1290       ! Zero-size cells at closed boundaries if cell points provided, 
    1291       ! otherwise they are closed cells with unrealistic bounds 
    1292       IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN 
    1293          IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
    1294             DO jn = 1, 4        ! (West or jpni = 1), closed E-W 
    1295                z_bnds(jn,1,:,1) = plat_pnt(1,:)  ;  z_bnds(jn,1,:,2) = plon_pnt(1,:) 
    1296             END DO 
    1297          ENDIF 
    1298          IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
    1299             DO jn = 1, 4        ! (East or jpni = 1), closed E-W 
    1300                z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:)  ;  z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:) 
    1301             END DO 
    1302          ENDIF 
    1303          IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN 
    1304             DO jn = 1, 4        ! South or (jpnj = 1, not symmetric) 
    1305                z_bnds(jn,:,1,1) = plat_pnt(:,1)  ;  z_bnds(jn,:,1,2) = plon_pnt(:,1) 
    1306             END DO 
    1307          ENDIF 
    1308          IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio  < 3 ) THEN 
    1309             DO jn = 1, 4        ! (North or jpnj = 1), no north fold 
    1310                z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj)  ;  z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj) 
    1311             END DO 
    1312          ENDIF 
    1313       ENDIF 
    1314  
    1315       ! Rotate cells at the north fold 
    1316       IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN 
    1317          DO jj = 1, jpj 
    1318             DO ji = 1, jpi 
    1319                IF( z_fld(ji,jj) == -1. ) THEN 
    1320                   z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 
    1321                   z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 
    1322                   z_bnds(:,ji,jj,:) = z_rot(:,:) 
    1323                ENDIF 
    1324             END DO 
    1325          END DO 
    1326  
    1327       ! Invert cells at the symmetric equator 
    1328       ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN 
    1329          DO ji = 1, jpi 
    1330             z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 
    1331             z_rot(3:4,:) = z_bnds(1:2,ji,1,:) 
    1332             z_bnds(:,ji,1,:) = z_rot(:,:) 
    1333          END DO 
    1334       ENDIF 
    1335  
    1336       CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)),           & 
    1337                                                bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 
    1338  
    1339       DEALLOCATE( z_bnds, z_fld, z_rot )  
    1340  
    1341    END SUBROUTINE set_grid_bounds 
    1342  
    1343  
    1344    SUBROUTINE set_grid_znl( plat ) 
    1345       !!---------------------------------------------------------------------- 
    1346       !!                     ***  ROUTINE set_grid_znl  *** 
    1347       !! 
    1348       !! ** Purpose :   define grids for zonal mean 
    1349       !! 
    1350       !!---------------------------------------------------------------------- 
    1351       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
    1352       ! 
    1353       REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon 
    1354       INTEGER  :: ni,nj, ix, iy 
    1355  
    1356        
    1357       ni=nlei-nldi+1 ; nj=nlej-nldj+1            ! define zonal mean domain (jpj*jpk) 
    1358       ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0. 
    1359  
    1360       CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 
    1361       CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    1362       CALL iom_set_domain_attr("gznl", lonvalue = zlon,   & 
    1363          &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
    1364       ! 
    1365       CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
    1366       CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 
    1367       CALL iom_update_file_name('ptr') 
    1368       ! 
    1369    END SUBROUTINE set_grid_znl 
    1370  
    1371    SUBROUTINE set_scalar 
    1372       !!---------------------------------------------------------------------- 
    1373       !!                     ***  ROUTINE set_scalar  *** 
    1374       !! 
    1375       !! ** Purpose :   define fake grids for scalar point 
    1376       !! 
    1377       !!---------------------------------------------------------------------- 
    1378       REAL(wp), DIMENSION(1)   ::   zz = 1. 
    1379       !!---------------------------------------------------------------------- 
    1380       CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 
    1381       CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 
    1382        
    1383       zz=REAL(narea,wp) 
    1384       CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 
    1385  
    1386    END SUBROUTINE set_scalar 
    1387  
    1388  
    1389    SUBROUTINE set_xmlatt 
    1390       !!---------------------------------------------------------------------- 
    1391       !!                     ***  ROUTINE set_xmlatt  *** 
    1392       !! 
    1393       !! ** Purpose :   automatic definitions of some of the xml attributs... 
    1394       !! 
    1395       !!---------------------------------------------------------------------- 
    1396       CHARACTER(len=1),DIMENSION( 3) ::   clgrd                    ! suffix name 
    1397       CHARACTER(len=256)             ::   clsuff                   ! suffix name 
    1398       CHARACTER(len=1)               ::   cl1                      ! 1 character 
    1399       CHARACTER(len=2)               ::   cl2                      ! 2 characters 
    1400       CHARACTER(len=3)               ::   cl3                      ! 3 characters 
    1401       INTEGER                        ::   ji, jg                   ! loop counters 
    1402       INTEGER                        ::   ix, iy                   ! i-,j- index 
    1403       REAL(wp)        ,DIMENSION(11) ::   zlontao                  ! longitudes of tao    moorings 
    1404       REAL(wp)        ,DIMENSION( 7) ::   zlattao                  ! latitudes  of tao    moorings 
    1405       REAL(wp)        ,DIMENSION( 4) ::   zlonrama                 ! longitudes of rama   moorings 
    1406       REAL(wp)        ,DIMENSION(11) ::   zlatrama                 ! latitudes  of rama   moorings 
    1407       REAL(wp)        ,DIMENSION( 3) ::   zlonpira                 ! longitudes of pirata moorings 
    1408       REAL(wp)        ,DIMENSION( 9) ::   zlatpira                 ! latitudes  of pirata moorings 
    1409       !!---------------------------------------------------------------------- 
    1410       !  
    1411       ! frequency of the call of iom_put (attribut: freq_op) 
    1412       WRITE(cl1,'(i1)')        1   ;   CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts') 
    1413         
    1414       ! output file names (attribut: name) 
    1415       DO ji = 1, 9 
    1416          WRITE(cl1,'(i1)') ji  
    1417          CALL iom_update_file_name('file'//cl1) 
    1418       END DO 
    1419       DO ji = 1, 99 
    1420          WRITE(cl2,'(i2.2)') ji  
    1421          CALL iom_update_file_name('file'//cl2) 
    1422       END DO 
    1423       DO ji = 1, 999 
    1424          WRITE(cl3,'(i3.3)') ji  
    1425          CALL iom_update_file_name('file'//cl3) 
    1426       END DO 
    1427  
    1428       ! Zooms... 
    1429       clgrd = (/ 'T', 'U', 'W' /)  
    1430       DO jg = 1, SIZE(clgrd)                                                                   ! grid type 
    1431          cl1 = clgrd(jg) 
    1432          ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    1433          CALL dom_ngb( 0., 0., ix, iy, cl1 ) 
    1434          CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 
    1435          CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             ) 
    1436          CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') 
    1437          CALL iom_update_file_name('Eq'//cl1) 
    1438       END DO 
    1439       ! TAO moorings (attributs: ibegin, jbegin, name_suffix) 
    1440       zlontao = (/ 137.0, 147.0, 156.0, 165.0, -180.0, -170.0, -155.0, -140.0, -125.0, -110.0, -95.0 /) 
    1441       zlattao = (/  -8.0,  -5.0,  -2.0,   0.0,    2.0,    5.0,    8.0 /) 
    1442       CALL set_mooring( zlontao, zlattao ) 
    1443       ! RAMA moorings (attributs: ibegin, jbegin, name_suffix) 
    1444       zlonrama = (/  55.0,  67.0, 80.5, 90.0 /) 
    1445       zlatrama = (/ -16.0, -12.0, -8.0, -4.0, -1.5, 0.0, 1.5, 4.0, 8.0, 12.0, 15.0 /) 
    1446       CALL set_mooring( zlonrama, zlatrama ) 
    1447       ! PIRATA moorings (attributs: ibegin, jbegin, name_suffix) 
    1448       zlonpira = (/ -38.0, -23.0, -10.0 /) 
    1449       zlatpira = (/ -19.0, -14.0,  -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 
    1450       CALL set_mooring( zlonpira, zlatpira ) 
    1451  
    1452        
    1453    END SUBROUTINE set_xmlatt 
    1454  
    1455  
    1456    SUBROUTINE set_mooring( plon, plat) 
    1457       !!---------------------------------------------------------------------- 
    1458       !!                     ***  ROUTINE set_mooring  *** 
    1459       !! 
    1460       !! ** Purpose :   automatic definitions of moorings xml attributs... 
    1461       !! 
    1462       !!---------------------------------------------------------------------- 
    1463       REAL(wp), DIMENSION(:), INTENT(in) ::  plon, plat           ! longitudes/latitudes oft the mooring 
    1464       ! 
    1465 !!$      CHARACTER(len=1),DIMENSION(4) ::   clgrd = (/ 'T', 'U', 'V', 'W' /)   ! suffix name 
    1466       CHARACTER(len=1),DIMENSION(1) ::   clgrd = (/ 'T' /)        ! suffix name 
    1467       CHARACTER(len=256)            ::   clname                   ! file name 
    1468       CHARACTER(len=256)            ::   clsuff                   ! suffix name 
    1469       CHARACTER(len=1)              ::   cl1                      ! 1 character 
    1470       CHARACTER(len=6)              ::   clon,clat                ! name of longitude, latitude 
    1471       INTEGER                       ::   ji, jj, jg               ! loop counters 
    1472       INTEGER                       ::   ix, iy                   ! i-,j- index 
    1473       REAL(wp)                      ::   zlon, zlat 
    1474       !!---------------------------------------------------------------------- 
    1475       DO jg = 1, SIZE(clgrd) 
    1476          cl1 = clgrd(jg) 
    1477          DO ji = 1, SIZE(plon) 
    1478             DO jj = 1, SIZE(plat) 
    1479                zlon = plon(ji) 
    1480                zlat = plat(jj) 
    1481                ! modifications for RAMA moorings 
    1482                IF( zlon ==  67. .AND. zlat ==  15. )   zlon =  65. 
    1483                IF( zlon ==  90. .AND. zlat <=  -4. )   zlon =  95. 
    1484                IF( zlon ==  95. .AND. zlat ==  -4. )   zlat =  -5. 
    1485                ! modifications for PIRATA moorings 
    1486                IF( zlon == -38. .AND. zlat == -19. )   zlon = -34. 
    1487                IF( zlon == -38. .AND. zlat == -14. )   zlon = -32. 
    1488                IF( zlon == -38. .AND. zlat ==  -8. )   zlon = -30. 
    1489                IF( zlon == -38. .AND. zlat ==   0. )   zlon = -35. 
    1490                IF( zlon == -23. .AND. zlat ==  20. )   zlat =  21. 
    1491                IF( zlon == -10. .AND. zlat == -14. )   zlat = -10. 
    1492                IF( zlon == -10. .AND. zlat ==  -8. )   zlat =  -6. 
    1493                IF( zlon == -10. .AND. zlat ==   4. ) THEN   ;   zlon = 0.   ;   zlat = 0.   ;   ENDIF 
    1494                CALL dom_ngb( zlon, zlat, ix, iy, cl1 ) 
    1495                IF( zlon >= 0. ) THEN   
    1496                   IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT( zlon), 'e' 
    1497                   ELSE                                      ;   WRITE(clon, '(f5.1,a)')       zlon , 'e' 
    1498                   ENDIF 
    1499                ELSE              
    1500                   IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT(-zlon), 'w' 
    1501                   ELSE                                      ;   WRITE(clon, '(f5.1,a)')      -zlon , 'w' 
    1502                   ENDIF 
    1503                ENDIF 
    1504                IF( zlat >= 0. ) THEN   
    1505                   IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT( zlat), 'n' 
    1506                   ELSE                                      ;   WRITE(clat, '(f4.1,a)')       zlat , 'n' 
    1507                   ENDIF 
    1508                ELSE              
    1509                   IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT(-zlat), 's' 
    1510                   ELSE                                      ;   WRITE(clat, '(f4.1,a)')      -zlat , 's' 
    1511                   ENDIF 
    1512                ENDIF 
    1513                clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 
    1514                CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 
    1515                CALL iom_get_file_attr   (TRIM(clname)//cl1, name_suffix = clsuff                         ) 
    1516                CALL iom_set_file_attr   (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname)) 
    1517                CALL iom_update_file_name(TRIM(clname)//cl1) 
    1518             END DO 
    1519          END DO 
    1520       END DO 
    1521        
    1522    END SUBROUTINE set_mooring 
    1523  
    1524     
    1525    SUBROUTINE iom_update_file_name( cdid ) 
    1526       !!---------------------------------------------------------------------- 
    1527       !!                     ***  ROUTINE iom_update_file_name  *** 
    1528       !! 
    1529       !! ** Purpose :    
    1530       !! 
    1531       !!---------------------------------------------------------------------- 
    1532       CHARACTER(LEN=*)          , INTENT(in) ::   cdid 
    1533       ! 
    1534       CHARACTER(LEN=256) ::   clname 
    1535       CHARACTER(LEN=20)  ::   clfreq 
    1536       CHARACTER(LEN=20)  ::   cldate 
    1537       INTEGER            ::   idx 
    1538       INTEGER            ::   jn 
    1539       INTEGER            ::   itrlen 
    1540       INTEGER            ::   iyear, imonth, iday, isec 
    1541       REAL(wp)           ::   zsec 
    1542       LOGICAL            ::   llexist 
    1543       !!---------------------------------------------------------------------- 
    1544  
    1545       DO jn = 1,2 
    1546  
    1547          IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = clfreq ) 
    1548          IF( jn == 2 )   CALL iom_get_file_attr( cdid, name_suffix = clname ) 
    1549  
    1550          IF ( TRIM(clname) /= '' ) THEN  
    1551  
    1552             idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 
    1553             DO WHILE ( idx /= 0 )  
    1554                clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname)) 
    1555                idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 
    1556             END DO 
    1557  
    1558             idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
    1559             DO WHILE ( idx /= 0 )  
    1560                IF ( TRIM(clfreq) /= '' ) THEN 
    1561                   itrlen = LEN_TRIM(clfreq) 
    1562                   IF ( clfreq(itrlen-1:itrlen) == 'mo' ) clfreq = clfreq(1:itrlen-1) 
    1563                   clname = clname(1:idx-1)//TRIM(clfreq)//clname(idx+6:LEN_TRIM(clname)) 
    1564                ELSE 
    1565                   CALL ctl_stop('error in the name of file id '//TRIM(cdid),   & 
    1566                      & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) ) 
    1567                ENDIF 
    1568                idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
    1569             END DO 
    1570  
    1571             idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 
    1572             DO WHILE ( idx /= 0 )  
    1573                cldate = iom_sdate( fjulday - rdt / rday ) 
    1574                clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname)) 
    1575                idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 
    1576             END DO 
    1577  
    1578             idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 
    1579             DO WHILE ( idx /= 0 )  
    1580                cldate = iom_sdate( fjulday - rdt / rday, ldfull = .TRUE. ) 
    1581                clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname)) 
    1582                idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 
    1583             END DO 
    1584  
    1585             idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 
    1586             DO WHILE ( idx /= 0 )  
    1587                cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 
    1588                clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) 
    1589                idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 
    1590             END DO 
    1591  
    1592             idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 
    1593             DO WHILE ( idx /= 0 )  
    1594                cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 
    1595                clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) 
    1596                idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 
    1597             END DO 
    1598  
    1599             IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    1600             IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname ) 
    1601             IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname ) 
    1602  
    1603          ENDIF 
    1604  
    1605       END DO 
    1606  
    1607    END SUBROUTINE iom_update_file_name 
    1608  
    1609  
    1610    FUNCTION iom_sdate( pjday, ld24, ldfull ) 
    1611       !!---------------------------------------------------------------------- 
    1612       !!                     ***  ROUTINE iom_sdate  *** 
    1613       !! 
    1614       !! ** Purpose :   send back the date corresponding to the given julian day 
    1615       !! 
    1616       !!---------------------------------------------------------------------- 
    1617       REAL(wp), INTENT(in   )           ::   pjday         ! julian day 
    1618       LOGICAL , INTENT(in   ), OPTIONAL ::   ld24          ! true to force 24:00 instead of 00:00 
    1619       LOGICAL , INTENT(in   ), OPTIONAL ::   ldfull        ! true to get the compleate date: yyyymmdd_hh:mm:ss 
    1620       ! 
    1621       CHARACTER(LEN=20) ::   iom_sdate 
    1622       CHARACTER(LEN=50) ::   clfmt                         !  format used to write the date  
    1623       INTEGER           ::   iyear, imonth, iday, ihour, iminute, isec 
    1624       REAL(wp)          ::   zsec 
    1625       LOGICAL           ::   ll24, llfull 
    1626       ! 
    1627       IF( PRESENT(ld24) ) THEN   ;   ll24 = ld24 
    1628       ELSE                       ;   ll24 = .FALSE. 
    1629       ENDIF 
    1630  
    1631       IF( PRESENT(ldfull) ) THEN   ;   llfull = ldfull 
    1632       ELSE                         ;   llfull = .FALSE. 
    1633       ENDIF 
    1634  
    1635       CALL ju2ymds( pjday, iyear, imonth, iday, zsec ) 
    1636       isec = NINT(zsec) 
    1637  
    1638       IF ( ll24 .AND. isec == 0 ) THEN   ! 00:00 of the next day -> move to 24:00 of the current day 
    1639          CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec ) 
    1640          isec = 86400 
    1641       ENDIF 
    1642  
    1643       IF( iyear < 10000 ) THEN   ;   clfmt = "i4.4,2i2.2"                ! format used to write the date  
    1644       ELSE                       ;   WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1 
    1645       ENDIF 
    1646        
    1647 !$AGRIF_DO_NOT_TREAT       
    1648 ! Should be fixed in the conv 
    1649       IF( llfull ) THEN  
    1650          clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" 
    1651          ihour   = isec / 3600 
    1652          isec    = MOD(isec, 3600) 
    1653          iminute = isec / 60 
    1654          isec    = MOD(isec, 60) 
    1655          WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday, ihour, iminute, isec    ! date of the end of run 
    1656       ELSE 
    1657          WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday                          ! date of the end of run 
    1658       ENDIF 
    1659 !$AGRIF_END_DO_NOT_TREAT       
    1660  
    1661    END FUNCTION iom_sdate 
    1662943 
    1663944 
    1664945   LOGICAL FUNCTION iom_use( cdname ) 
    1665946      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    1666       iom_use = xios_field_is_active( cdname ) 
     947      iom_use = .FALSE. 
    1667948   END FUNCTION iom_use 
    1668949    

  • branches/2017/dev_merge_2017/NEMOGCM/TOOLS/DOMAINcfg/src/nemogcm.f90

    r7200 r9079  
    5252   USE lib_mpp        ! distributed memory computing 
    5353 
    54    USE xios           ! xIOserver 
    55  
    5654   USE lbcnfd , ONLY  : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges  
    5755 
    … …  
    112110      CALL nemo_closefile 
    113111      ! 
    114       CALL xios_finalize                  ! end mpp communications with xios 
    115112      ! 
    116113   END SUBROUTINE nemo_gcm 
    … …  
    137134      ! 
    138135      cltxt = '' 
    139       cxios_context = 'nemo' 
    140136      ! 
    141137      !                             ! Open reference namelist and configuration namelist files 
    … …  
    167163      !                             !      on unit number numond on first proc   ! 
    168164      !                             !--------------------------------------------! 
    169       IF( Agrif_Root() ) THEN 
    170             CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
    171       ENDIF 
    172165      ! Nodes selection (control print return in cltxt) 
    173       narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 
     166      ilocal_comm = 0 
     167      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) 
    174168      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
    175169 

  • branches/2017/dev_merge_2017/NEMOGCM/TOOLS/DOMAINcfg/src/step_oce.f90

    r6951 r9079  
    2222 
    2323 
    24    USE xios 
    2524 
    2625   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.