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 7646 for trunk/NEMOGCM/NEMO/OPA_SRC/IOM – NEMO

Ignore:
Timestamp:
2017-02-06T10:25:03+01:00 (7 years ago)
Author:
timgraham
Message:

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge --reintegrate ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

Location:
trunk/NEMOGCM/NEMO/OPA_SRC/IOM
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r6140 r7646  
    1818   PUBLIC 
    1919 
    20   
    21    ! 
    2220   !!---------------------------------------------------------------------- 
    2321   !!                   namrun namelist parameters 
    … …  
    4644   LOGICAL       ::   ln_clobber       !: clobber (overwrite) an existing file 
    4745   INTEGER       ::   nn_chunksz       !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 
     46 
    4847#if defined key_netcdf4 
    4948   !!---------------------------------------------------------------------- 
    … …  
    6362   !                           !                     to produce netcdf3-compatible files  
    6463#endif 
     64 
    6565!$AGRIF_DO_NOT_TREAT 
    6666   TYPE(snc4_ctl)     :: snc4set        !: netcdf4 chunking control structure (always needed for decision making) 
    … …  
    9595   !!                    output monitoring 
    9696   !!---------------------------------------------------------------------- 
    97    LOGICAL ::   ln_ctl       !: run control for debugging 
    98    INTEGER ::   nn_timing    !: run control for timing 
    99    INTEGER ::   nn_diacfl    !: flag whether to create CFL diagnostics 
    100    INTEGER ::   nn_print     !: level of print (0 no print) 
    101    INTEGER ::   nn_ictls     !: Start i indice for the SUM control 
    102    INTEGER ::   nn_ictle     !: End   i indice for the SUM control 
    103    INTEGER ::   nn_jctls     !: Start j indice for the SUM control 
    104    INTEGER ::   nn_jctle     !: End   j indice for the SUM control 
    105    INTEGER ::   nn_isplt     !: number of processors following i 
    106    INTEGER ::   nn_jsplt     !: number of processors following j 
    107    INTEGER ::   nn_bench     !: benchmark parameter (0/1) 
    108    INTEGER ::   nn_bit_cmp   =    0    !: bit reproducibility  (0/1) 
    109  
     97   LOGICAL ::   ln_ctl           !: run control for debugging 
     98   INTEGER ::   nn_timing        !: run control for timing 
     99   INTEGER ::   nn_diacfl        !: flag whether to create CFL diagnostics 
     100   INTEGER ::   nn_print         !: level of print (0 no print) 
     101   INTEGER ::   nn_ictls         !: Start i indice for the SUM control 
     102   INTEGER ::   nn_ictle         !: End   i indice for the SUM control 
     103   INTEGER ::   nn_jctls         !: Start j indice for the SUM control 
     104   INTEGER ::   nn_jctle         !: End   j indice for the SUM control 
     105   INTEGER ::   nn_isplt         !: number of processors following i 
     106   INTEGER ::   nn_jsplt         !: number of processors following j 
     107   INTEGER ::   nn_bench         !: benchmark parameter (0/1) 
     108   INTEGER ::   nn_bit_cmp = 0   !: bit reproducibility  (0/1) 
    110109   !                                           
    111    INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt, nbench    !: OLD namelist names 
     110   INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt    !: OLD namelist names 
    112111 
    113112   INTEGER ::   ijsplt     =    1      !: nb of local domain = nb of processors 
    … …  
    138137   !!                          Run control   
    139138   !!---------------------------------------------------------------------- 
     139   INTEGER       ::   no_print = 0          !: optional argument of fld_fill (if present, suppress some control print) 
    140140   INTEGER       ::   nstop = 0             !: error flag (=number of reason for a premature stop run) 
    141141   INTEGER       ::   nwarn = 0             !: warning flag (=number of warning found during the run) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r6519 r7646  
    99   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case   
    1010   !!            3.6  ! 2014-15  DIMG format removed 
     11   !!            3.6  ! 2015-15  (J. Harle) Added procedure to read REAL attributes 
    1112   !!-------------------------------------------------------------------- 
    1213 
    … …  
    5253   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag 
    5354#endif 
    54    PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 
    55    PUBLIC iom_getatt, iom_use, iom_context_finalize 
     55   PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get 
     56   PUBLIC iom_getatt, iom_putatt, iom_gettime, iom_rstput, iom_put 
     57   PUBLIC iom_use, iom_context_finalize 
    5658 
    5759   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
    … …  
    6769   END INTERFACE 
    6870   INTERFACE iom_getatt 
    69       MODULE PROCEDURE iom_g0d_intatt 
     71      MODULE PROCEDURE iom_g0d_iatt, iom_g0d_ratt, iom_g0d_catt 
     72   END INTERFACE 
     73   INTERFACE iom_putatt 
     74      MODULE PROCEDURE iom_p0d_iatt, iom_p0d_ratt, iom_p0d_catt 
    7075   END INTERFACE 
    7176   INTERFACE iom_rstput 
    … …  
    9398      CHARACTER(len=*), INTENT(in)  :: cdname 
    9499#if defined key_iomput 
    95       TYPE(xios_time)   :: dtime    = xios_time(0, 0, 0, 0, 0, 0) 
    96       CHARACTER(len=19) :: cldate  
     100 
     101      TYPE(xios_duration) :: dtime    = xios_duration(0, 0, 0, 0, 0, 0) 
     102      TYPE(xios_date)     :: start_date 
    97103      CHARACTER(len=10) :: clname 
    98       INTEGER           ::   ji 
    99       ! 
    100       REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 
    101       !!---------------------------------------------------------------------- 
    102  
    103       ALLOCATE( z_bnds(jpk,2) ) 
     104      INTEGER           :: ji, jkmin 
     105      ! 
     106      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 
     107      !!---------------------------------------------------------------------- 
     108 
     109      ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) ) 
    104110 
    105111      clname = cdname 
    … …  
    108114      CALL iom_swap( cdname ) 
    109115 
    110       ! calendar parameters 
     116 
     117      ! Calendar type is now defined in xml file  
    111118      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    112       CASE ( 1)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian") 
    113       CASE ( 0)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "NoLeap") 
    114       CASE (30)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "D360") 
     119      CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), & 
     120          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
     121      CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(1900,01,01,00,00,00), & 
     122          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
     123      CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(1900,01,01,00,00,00), & 
     124          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
    115125      END SELECT 
    116       WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':',i2.2,':00')") nyear,nmonth,nday,nhour,nminute 
    117       CALL xios_set_context_attr(TRIM(clname), start_date=cldate ) 
    118126 
    119127      ! horizontal grid definition 
    … …  
    169177 
    170178      ! Add vertical grid bounds 
    171       z_bnds(:      ,1) = gdepw_1d(:) 
    172       z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 
    173       z_bnds(jpk:   ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 
    174       CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 
    175       CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 
    176       CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 
    177       z_bnds(:    ,2) = gdept_1d(:) 
    178       z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 
    179       z_bnds(1    ,1) = gdept_1d(1) - e3w_1d(1) 
    180       CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 
     179      jkmin = MIN(2,jpk)  ! in case jpk=1 (i.e. sas2D) 
     180      zt_bnds(2,:        ) = gdept_1d(:) 
     181      zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 
     182      zt_bnds(1,1        ) = gdept_1d(1) - e3w_1d(1) 
     183      zw_bnds(1,:        ) = gdepw_1d(:) 
     184      zw_bnds(2,1:jpkm1  ) = gdepw_1d(jkmin:jpk) 
     185      zw_bnds(2,jpk:     ) = gdepw_1d(jpk) + e3t_1d(jpk) 
     186      CALL iom_set_axis_attr( "deptht", bounds=zt_bnds ) 
     187      CALL iom_set_axis_attr( "depthu", bounds=zt_bnds ) 
     188      CALL iom_set_axis_attr( "depthv", bounds=zt_bnds ) 
     189      CALL iom_set_axis_attr( "depthw", bounds=zw_bnds ) 
     190 
    181191 
    182192# if defined key_floats 
    … …  
    200210      CALL xios_update_calendar(0) 
    201211 
    202       DEALLOCATE( z_bnds ) 
     212      DEALLOCATE( zt_bnds, zw_bnds ) 
    203213 
    204214#endif 
    … …  
    789799                  ENDIF 
    790800                  IF( PRESENT(pv_r3d) ) THEN 
    791                      IF( idom == jpdom_data ) THEN                                  ; icnt(3) = jpkdta 
     801                     IF( idom == jpdom_data ) THEN                                  ; icnt(3) = jpkglo 
    792802                     ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN            ; istart(3) = kstart(3); icnt(3) = kcount(3) 
    793803                     ELSE                                                           ; icnt(3) = jpk 
    … …  
    971981   !!                   INTERFACE iom_getatt 
    972982   !!---------------------------------------------------------------------- 
    973    SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar ) 
     983   SUBROUTINE iom_g0d_iatt( kiomid, cdatt, pvar, cdvar ) 
    974984      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
    975985      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute 
    976986      INTEGER         , INTENT(  out)                 ::   pvar      ! read field 
     987      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable 
    977988      ! 
    978989      IF( kiomid > 0 ) THEN 
    979990         IF( iom_file(kiomid)%nfid > 0 ) THEN 
    980991            SELECT CASE (iom_file(kiomid)%iolib) 
    981             CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pvar ) 
     992            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN 
     993                                      CALL iom_nf90_getatt( kiomid, cdatt, pvar, cdvar=cdvar ) 
     994                                   ELSE 
     995                                      CALL iom_nf90_getatt( kiomid, cdatt, pvar ) 
     996                                   ENDIF 
    982997            CASE DEFAULT 
    983                CALL ctl_stop( 'iom_g0d_att: accepted IO library is only jpnf90' ) 
     998               CALL ctl_stop( 'iom_g0d_iatt: accepted IO library is only jpnf90' ) 
    984999            END SELECT 
    9851000         ENDIF 
    9861001      ENDIF 
    987    END SUBROUTINE iom_g0d_intatt 
    988  
     1002   END SUBROUTINE iom_g0d_iatt 
     1003 
     1004   SUBROUTINE iom_g0d_ratt( kiomid, cdatt, pvar, cdvar ) 
     1005      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
     1006      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute 
     1007      REAL(wp)        , INTENT(  out)                 ::   pvar      ! written field 
     1008      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable 
     1009      ! 
     1010      IF( kiomid > 0 ) THEN 
     1011         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1012            SELECT CASE (iom_file(kiomid)%iolib) 
     1013            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN 
     1014                                      CALL iom_nf90_getatt( kiomid, cdatt, pvar, cdvar=cdvar ) 
     1015                                   ELSE 
     1016                                      CALL iom_nf90_getatt( kiomid, cdatt, pvar ) 
     1017                                   ENDIF 
     1018            CASE DEFAULT     
     1019               CALL ctl_stop( 'iom_g0d_ratt: accepted IO library is only jpnf90' ) 
     1020            END SELECT 
     1021         ENDIF 
     1022      ENDIF 
     1023   END SUBROUTINE iom_g0d_ratt 
     1024 
     1025   SUBROUTINE iom_g0d_catt( kiomid, cdatt, pvar, cdvar ) 
     1026      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
     1027      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute 
     1028      CHARACTER(len=*), INTENT(  out)                 ::   pvar      ! written field 
     1029      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable 
     1030      ! 
     1031      IF( kiomid > 0 ) THEN 
     1032         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1033            SELECT CASE (iom_file(kiomid)%iolib) 
     1034            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN 
     1035                                      CALL iom_nf90_getatt( kiomid, cdatt, pvar, cdvar=cdvar ) 
     1036                                   ELSE 
     1037                                      CALL iom_nf90_getatt( kiomid, cdatt, pvar ) 
     1038                                   ENDIF 
     1039            CASE DEFAULT 
     1040               CALL ctl_stop( 'iom_g0d_ratt: accepted IO library is only jpnf90' ) 
     1041            END SELECT 
     1042         ENDIF 
     1043      ENDIF 
     1044   END SUBROUTINE iom_g0d_catt 
     1045 
     1046   !!---------------------------------------------------------------------- 
     1047   !!                   INTERFACE iom_putatt 
     1048   !!---------------------------------------------------------------------- 
     1049   SUBROUTINE iom_p0d_iatt( kiomid, cdatt, pvar, cdvar ) 
     1050      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
     1051      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute 
     1052      INTEGER         , INTENT(in   )                 ::   pvar      ! write field 
     1053      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable 
     1054      ! 
     1055      IF( kiomid > 0 ) THEN 
     1056         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1057            SELECT CASE (iom_file(kiomid)%iolib) 
     1058            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN 
     1059                                      CALL iom_nf90_putatt( kiomid, cdatt, pvar, cdvar=cdvar ) 
     1060                                   ELSE 
     1061                                      CALL iom_nf90_putatt( kiomid, cdatt, pvar ) 
     1062                                   ENDIF 
     1063            CASE DEFAULT 
     1064               CALL ctl_stop( 'iom_p0d_iatt: accepted IO library is only jpnf90' ) 
     1065            END SELECT 
     1066         ENDIF 
     1067      ENDIF 
     1068   END SUBROUTINE iom_p0d_iatt 
     1069 
     1070   SUBROUTINE iom_p0d_ratt( kiomid, cdatt, pvar, cdvar ) 
     1071      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
     1072      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute 
     1073      REAL(wp)        , INTENT(in   )                 ::   pvar      ! write field 
     1074      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable 
     1075      ! 
     1076      IF( kiomid > 0 ) THEN 
     1077         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1078            SELECT CASE (iom_file(kiomid)%iolib) 
     1079            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN 
     1080                                      CALL iom_nf90_putatt( kiomid, cdatt, pvar, cdvar=cdvar ) 
     1081                                   ELSE 
     1082                                      CALL iom_nf90_putatt( kiomid, cdatt, pvar ) 
     1083                                   ENDIF 
     1084            CASE DEFAULT     
     1085               CALL ctl_stop( 'iom_p0d_ratt: accepted IO library is only jpnf90' ) 
     1086            END SELECT 
     1087         ENDIF 
     1088      ENDIF 
     1089   END SUBROUTINE iom_p0d_ratt 
     1090 
     1091   SUBROUTINE iom_p0d_catt( kiomid, cdatt, pvar, cdvar ) 
     1092      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
     1093      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute 
     1094      CHARACTER(len=*), INTENT(in   )                 ::   pvar      ! write field 
     1095      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable 
     1096      ! 
     1097      IF( kiomid > 0 ) THEN 
     1098         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1099            SELECT CASE (iom_file(kiomid)%iolib) 
     1100            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN 
     1101                                      CALL iom_nf90_putatt( kiomid, cdatt, pvar, cdvar=cdvar ) 
     1102                                   ELSE 
     1103                                      CALL iom_nf90_putatt( kiomid, cdatt, pvar ) 
     1104                                   ENDIF 
     1105            CASE DEFAULT 
     1106               CALL ctl_stop( 'iom_p0d_ratt: accepted IO library is only jpnf90' ) 
     1107            END SELECT 
     1108         ENDIF 
     1109      ENDIF 
     1110   END SUBROUTINE iom_p0d_catt 
    9891111 
    9901112   !!---------------------------------------------------------------------- 
    … …  
    11301252      REAL(wp), DIMENSION(:)   , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
    11311253      REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area 
    1132       LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask 
     1254      LOGICAL, DIMENSION(:)   , OPTIONAL, INTENT(in) ::   mask 
     1255 
    11331256 
    11341257      IF ( xios_is_valid_domain     (cdid) ) THEN 
    11351258         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    11361259            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
    1137             &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       & 
    1138             &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  & 
    1139             &    bounds_lat=bounds_lat, area=area ) 
    1140       ENDIF 
    1141  
     1260            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      & 
     1261            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 
     1262     ENDIF 
    11421263      IF ( xios_is_valid_domaingroup(cdid) ) THEN 
    11431264         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    11441265            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
    1145             &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       & 
    1146             &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  & 
    1147             &    bounds_lat=bounds_lat, area=area ) 
    1148       ENDIF 
     1266            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      & 
     1267            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 
     1268      ENDIF 
     1269 
    11491270      CALL xios_solve_inheritance() 
    11501271 
    11511272   END SUBROUTINE iom_set_domain_attr 
     1273 
     1274 
     1275   SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj) 
     1276      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
     1277      INTEGER                  , OPTIONAL, INTENT(in) ::   ibegin, jbegin, ni, nj 
     1278 
     1279      IF ( xios_is_valid_zoom_domain     (cdid) ) THEN 
     1280          CALL xios_set_zoom_domain_attr     ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni,    & 
     1281            &   nj=nj) 
     1282     ENDIF 
     1283   END SUBROUTINE iom_set_zoom_domain_attr 
    11521284 
    11531285 
    … …  
    11561288      REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   paxis 
    11571289      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds 
     1290 
    11581291      IF ( PRESENT(paxis) ) THEN 
    1159          IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, size=SIZE(paxis), value=paxis ) 
    1160          IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis ) 
     1292         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=paxis ) 
     1293         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 
    11611294      ENDIF 
    11621295      IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds ) 
    … …  
    11681301   SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 
    11691302      CHARACTER(LEN=*)          , INTENT(in) ::   cdid 
    1170       CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_op 
    1171       CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_offset 
     1303      TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_op 
     1304      TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_offset 
    11721305      IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr       & 
    11731306    &     ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
    … …  
    11891322   SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 
    11901323      CHARACTER(LEN=*)          , INTENT(in ) ::   cdid 
    1191       CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix, output_freq 
     1324      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix 
     1325      TYPE(xios_duration), OPTIONAL , INTENT(out) :: output_freq 
    11921326      LOGICAL                                 ::   llexist1,llexist2,llexist3 
    11931327      !--------------------------------------------------------------------- 
    11941328      IF( PRESENT( name        ) )   name = ''          ! default values 
    11951329      IF( PRESENT( name_suffix ) )   name_suffix = '' 
    1196       IF( PRESENT( output_freq ) )   output_freq = '' 
     1330      IF( PRESENT( output_freq ) )   output_freq = xios_duration(0,0,0,0,0,0) 
    11971331      IF ( xios_is_valid_file     (cdid) ) THEN 
    11981332         CALL xios_solve_inheritance() 
    … …  
    12151349      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
    12161350      LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask 
    1217       IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask=mask ) 
    1218       IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask=mask ) 
     1351      IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask_3D=mask ) 
     1352      IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask_3D=mask ) 
    12191353      CALL xios_solve_inheritance() 
    12201354   END SUBROUTINE iom_set_grid_attr 
    … …  
    12581392      ni=nlei-nldi+1 ; nj=nlej-nldj+1 
    12591393 
    1260       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) 
     1394      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    12611395      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    12621396      CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   & 
    … …  
    12721406         END SELECT 
    12731407         ! 
    1274          CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni,nj    /)) /= 0. ) 
     1408         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj    /)) /= 0. ) 
    12751409         CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. ) 
    12761410      ENDIF 
    … …  
    14061540      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0. 
    14071541 
    1408       CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 
     1542      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     1543      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    14091544      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    14101545      CALL iom_set_domain_attr("gznl", lonvalue = zlon,   & 
    14111546         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
    1412       ! 
    1413       CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
    1414       CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 
     1547      CALL iom_set_zoom_domain_attr ("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 
     1548      ! 
    14151549      CALL iom_update_file_name('ptr') 
    14161550      ! 
    … …  
    14261560      REAL(wp), DIMENSION(1)   ::   zz = 1. 
    14271561      !!---------------------------------------------------------------------- 
    1428       CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 
     1562 
     1563      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1) 
    14291564      CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 
    14301565       
    … …  
    14551590      REAL(wp)        ,DIMENSION( 3) ::   zlonpira                 ! longitudes of pirata moorings 
    14561591      REAL(wp)        ,DIMENSION( 9) ::   zlatpira                 ! latitudes  of pirata moorings 
     1592      TYPE(xios_duration)            ::   f_op, f_of 
    14571593      !!---------------------------------------------------------------------- 
    14581594      !  
    14591595      ! frequency of the call of iom_put (attribut: freq_op) 
    1460       WRITE(cl1,'(i1)')        1   ;   CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts') 
    1461       WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC'             , freq_op = cl1//'ts', freq_offset='0ts') 
    1462       WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC_scalar'      , freq_op = cl1//'ts', freq_offset='0ts') 
    1463       WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('ptrc_T'          , freq_op = cl1//'ts', freq_offset='0ts') 
    1464       WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('diad_T'          , freq_op = cl1//'ts', freq_offset='0ts') 
    1465         
     1596      f_op%timestep = 1        ;  f_of%timestep = 0  ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) 
     1597      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of) 
     1598      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of) 
     1599      f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of) 
     1600      f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of) 
     1601 
    14661602      ! output file names (attribut: name) 
    14671603      DO ji = 1, 9 
    … …  
    14841620         ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    14851621         CALL dom_ngb( 0., 0., ix, iy, cl1 ) 
    1486          CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 
     1622         CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo) 
    14871623         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             ) 
    14881624         CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') 
    … …  
    15641700               ENDIF 
    15651701               clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 
    1566                CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 
     1702               CALL iom_set_zoom_domain_attr  (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1) 
     1703 
    15671704               CALL iom_get_file_attr   (TRIM(clname)//cl1, name_suffix = clsuff                         ) 
    15681705               CALL iom_set_file_attr   (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname)) 
    … …  
    15931730      REAL(wp)           ::   zsec 
    15941731      LOGICAL            ::   llexist 
     1732      TYPE(xios_duration)   ::   output_freq  
    15951733      !!---------------------------------------------------------------------- 
    15961734 
    15971735      DO jn = 1,2 
    15981736 
    1599          IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = clfreq ) 
     1737         output_freq = xios_duration(0,0,0,0,0,0) 
     1738         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = output_freq ) 
    16001739         IF( jn == 2 )   CALL iom_get_file_attr( cdid, name_suffix = clname ) 
    16011740 
    … …  
    16101749            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
    16111750            DO WHILE ( idx /= 0 )  
    1612                IF ( TRIM(clfreq) /= '' ) THEN 
    1613                   itrlen = LEN_TRIM(clfreq) 
    1614                   IF ( clfreq(itrlen-1:itrlen) == 'mo' ) clfreq = clfreq(1:itrlen-1) 
    1615                   clname = clname(1:idx-1)//TRIM(clfreq)//clname(idx+6:LEN_TRIM(clname)) 
    1616                ELSE 
     1751              IF ( output_freq%timestep /= 0) THEN 
     1752                  WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts'  
     1753                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1754              ELSE IF ( output_freq%hour /= 0 ) THEN 
     1755                  WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h'  
     1756                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1757              ELSE IF ( output_freq%day /= 0 ) THEN 
     1758                  WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d'  
     1759                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1760              ELSE IF ( output_freq%month /= 0 ) THEN    
     1761                  WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m'  
     1762                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1763              ELSE IF ( output_freq%year /= 0 ) THEN    
     1764                  WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y'  
     1765                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1766              ELSE 
    16171767                  CALL ctl_stop('error in the name of file id '//TRIM(cdid),   & 
    16181768                     & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) ) 
    1619                ENDIF 
    1620                idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
     1769              ENDIF 
     1770              clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname)) 
     1771              idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
    16211772            END DO 
    16221773 

  • trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90

    r6140 r7646  
    1818   PRIVATE 
    1919 
    20    INTEGER, PARAMETER, PUBLIC ::   jpdom_data          = 1   !: ( 1  :jpidta, 1  :jpjdta) 
     20   INTEGER, PARAMETER, PUBLIC ::   jpdom_data          = 1   !: ( 1  :jpiglo, 1  :jpjglo)    !!gm to be suppressed 
    2121   INTEGER, PARAMETER, PUBLIC ::   jpdom_global        = 2   !: ( 1  :jpiglo, 1  :jpjglo) 
    2222   INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 3   !: One of the 3 following cases 
    … …  
    3939   INTEGER, PARAMETER, PUBLIC ::   jp_i1    = 204      !: write INTEGER(1) 
    4040 
    41    INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 100   !: maximum number of simultaneously opened file 
    42    INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 600 !: maximum number of variables in one file 
     41   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 100  !: maximum number of simultaneously opened file 
     42   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 1200 !: maximum number of variables in one file 
    4343   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable 
    4444   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  5   !: maximum number of digits for the cpu number in the file name 

  • trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

    r6140 r7646  
    77   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO 
    88   !!             "   ! 07 07  (D. Storkey) Changes to iom_nf90_gettime 
     9   !!            3.6  ! 2015-15  (J. Harle) Added procedure to read REAL attributes 
    910   !!-------------------------------------------------------------------- 
    1011   !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes 
    … …  
    2930 
    3031   PUBLIC iom_nf90_open, iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_gettime, iom_nf90_rstput 
    31    PUBLIC iom_nf90_getatt 
     32   PUBLIC iom_nf90_getatt, iom_nf90_putatt 
    3233 
    3334   INTERFACE iom_nf90_get 
    … …  
    3536   END INTERFACE 
    3637   INTERFACE iom_nf90_getatt 
    37       MODULE PROCEDURE iom_nf90_intatt 
     38      MODULE PROCEDURE iom_nf90_giatt, iom_nf90_gratt, iom_nf90_gcatt 
     39   END INTERFACE 
     40   INTERFACE iom_nf90_putatt 
     41      MODULE PROCEDURE iom_nf90_piatt, iom_nf90_pratt, iom_nf90_pcatt 
    3842   END INTERFACE 
    3943   INTERFACE iom_nf90_rstput 
    … …  
    252256   END FUNCTION iom_nf90_varid 
    253257 
     258   !!---------------------------------------------------------------------- 
     259   !!                   INTERFACE iom_nf90_get 
     260   !!---------------------------------------------------------------------- 
    254261 
    255262   SUBROUTINE iom_nf90_g0d( kiomid, kvid, pvar, kstart ) 
    … …  
    312319   END SUBROUTINE iom_nf90_g123d 
    313320 
    314  
    315    SUBROUTINE iom_nf90_intatt( kiomid, cdatt, pvar ) 
    316       !!----------------------------------------------------------------------- 
    317       !!                  ***  ROUTINE  iom_nf90_intatt  *** 
     321   !!---------------------------------------------------------------------- 
     322   !!                   INTERFACE iom_nf90_getatt 
     323   !!---------------------------------------------------------------------- 
     324 
     325   SUBROUTINE iom_nf90_giatt( kiomid, cdatt, pv_i0d, cdvar) 
     326      !!----------------------------------------------------------------------- 
     327      !!                  ***  ROUTINE  iom_nf90_giatt  *** 
    318328      !! 
    319329      !! ** Purpose : read an integer attribute with NF90 
     330      !!              (either a global attribute (default) or a variable 
     331      !!               attribute if optional variable name is supplied (cdvar)) 
    320332      !!----------------------------------------------------------------------- 
    321333      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file 
    322334      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name 
    323       INTEGER         , INTENT(  out) ::   pvar     ! read field 
     335      INTEGER         , INTENT(  out) ::   pv_i0d   ! read field 
     336      CHARACTER(len=*), INTENT(in   ), OPTIONAL     & 
     337                      &               ::   cdvar    ! name of the variable 
    324338      ! 
    325339      INTEGER                         ::   if90id   ! temporary integer 
     340      INTEGER                         ::   ivarid   ! NetCDF variable Id 
    326341      LOGICAL                         ::   llok     ! temporary logical 
    327342      CHARACTER(LEN=100)              ::   clinfo   ! info character 
    328343      !--------------------------------------------------------------------- 
    329       !  
     344      ! 
    330345      if90id = iom_file(kiomid)%nfid 
    331       llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr 
     346      IF( PRESENT(cdvar) ) THEN 
     347         ! check the variable exists in the file 
     348         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr 
     349         IF( llok ) THEN 
     350            ! check the variable has the attribute required 
     351            llok = NF90_Inquire_attribute(if90id, ivarid, cdatt) == nf90_noerr 
     352         ELSE 
     353            CALL ctl_warn('iom_nf90_getatt: no variable '//cdvar//' found') 
     354         ENDIF 
     355      ELSE 
     356         llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr 
     357         ivarid = NF90_GLOBAL 
     358      ENDIF 
     359! 
    332360      IF( llok) THEN 
    333          clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', att: '//TRIM(cdatt) 
    334          CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pvar), clinfo) 
     361         clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', giatt: '//TRIM(cdatt) 
     362         CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values=pv_i0d), clinfo) 
    335363      ELSE 
    336364         CALL ctl_warn('iom_nf90_getatt: no attribute '//cdatt//' found') 
    337          pvar = -999 
    338       ENDIF 
    339       !  
    340    END SUBROUTINE iom_nf90_intatt 
     365         pv_i0d = -999 
     366      ENDIF 
     367      ! 
     368   END SUBROUTINE iom_nf90_giatt 
     369 
     370   SUBROUTINE iom_nf90_gratt( kiomid, cdatt, pv_r0d, cdvar) 
     371      !!----------------------------------------------------------------------- 
     372      !!                  ***  ROUTINE  iom_nf90_gratt  *** 
     373      !! 
     374      !! ** Purpose : read a real attribute with NF90 
     375      !!              (either a global attribute (default) or a variable 
     376      !!               attribute if optional variable name is supplied (cdvar)) 
     377      !!----------------------------------------------------------------------- 
     378      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file 
     379      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name 
     380      REAL(wp)        , INTENT(  out) ::   pv_r0d   ! read field 
     381      CHARACTER(len=*), INTENT(in   ), OPTIONAL     & 
     382                      &               ::   cdvar    ! name of the variable 
     383      ! 
     384      INTEGER                         ::   if90id   ! temporary integer 
     385      INTEGER                         ::   ivarid   ! NetCDF variable Id 
     386      LOGICAL                         ::   llok     ! temporary logical 
     387      CHARACTER(LEN=100)              ::   clinfo   ! info character 
     388      !--------------------------------------------------------------------- 
     389      ! 
     390      if90id = iom_file(kiomid)%nfid 
     391      IF( PRESENT(cdvar) ) THEN 
     392         ! check the variable exists in the file 
     393         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr 
     394         IF( llok ) THEN 
     395            ! check the variable has the attribute required 
     396            llok = NF90_Inquire_attribute(if90id, ivarid, cdatt) == nf90_noerr 
     397         ELSE 
     398            CALL ctl_warn('iom_nf90_getatt: no variable '//cdvar//' found') 
     399         ENDIF 
     400      ELSE 
     401         llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr 
     402         ivarid = NF90_GLOBAL 
     403      ENDIF 
     404! 
     405      IF( llok) THEN 
     406         clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', gratt: '//TRIM(cdatt) 
     407         CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values=pv_r0d), clinfo) 
     408      ELSE 
     409         CALL ctl_warn('iom_nf90_getatt: no attribute '//cdatt//' found') 
     410         pv_r0d = -999._wp 
     411      ENDIF 
     412      ! 
     413   END SUBROUTINE iom_nf90_gratt 
     414 
     415   SUBROUTINE iom_nf90_gcatt( kiomid, cdatt, pv_c0d, cdvar) 
     416      !!----------------------------------------------------------------------- 
     417      !!                  ***  ROUTINE  iom_nf90_gcatt  *** 
     418      !! 
     419      !! ** Purpose : read a character attribute with NF90 
     420      !!              (either a global attribute (default) or a variable 
     421      !!               attribute if optional variable name is supplied (cdvar)) 
     422      !!----------------------------------------------------------------------- 
     423      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file 
     424      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name 
     425      CHARACTER(len=*), INTENT(  out) ::   pv_c0d   ! read field 
     426      CHARACTER(len=*), INTENT(in   ), OPTIONAL     & 
     427                      &               ::   cdvar    ! name of the variable 
     428      ! 
     429      INTEGER                         ::   if90id   ! temporary integer 
     430      INTEGER                         ::   ivarid   ! NetCDF variable Id 
     431      LOGICAL                         ::   llok     ! temporary logical 
     432      CHARACTER(LEN=100)              ::   clinfo   ! info character 
     433      !--------------------------------------------------------------------- 
     434      ! 
     435      if90id = iom_file(kiomid)%nfid 
     436      IF( PRESENT(cdvar) ) THEN 
     437         ! check the variable exists in the file 
     438         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr 
     439         IF( llok ) THEN 
     440            ! check the variable has the attribute required 
     441            llok = NF90_Inquire_attribute(if90id, ivarid, cdatt) == nf90_noerr 
     442         ELSE 
     443            CALL ctl_warn('iom_nf90_getatt: no variable '//cdvar//' found') 
     444         ENDIF 
     445      ELSE 
     446         llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr 
     447         ivarid = NF90_GLOBAL 
     448      ENDIF 
     449! 
     450      IF( llok) THEN 
     451         clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', gcatt: '//TRIM(cdatt) 
     452         CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values=pv_c0d), clinfo) 
     453      ELSE 
     454         CALL ctl_warn('iom_nf90_getatt: no attribute '//cdatt//' found') 
     455         pv_c0d = '!' 
     456      ENDIF 
     457      ! 
     458   END SUBROUTINE iom_nf90_gcatt 
     459 
     460   !!---------------------------------------------------------------------- 
     461   !!                   INTERFACE iom_nf90_putatt 
     462   !!---------------------------------------------------------------------- 
     463 
     464   SUBROUTINE iom_nf90_piatt( kiomid, cdatt, pv_i0d, cdvar) 
     465      !!----------------------------------------------------------------------- 
     466      !!                  ***  ROUTINE  iom_nf90_piatt  *** 
     467      !! 
     468      !! ** Purpose : write an integer attribute with NF90 
     469      !!              (either a global attribute (default) or a variable 
     470      !!               attribute if optional variable name is supplied (cdvar)) 
     471      !!----------------------------------------------------------------------- 
     472      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file 
     473      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name 
     474      INTEGER         , INTENT(in   ) ::   pv_i0d   ! write field 
     475      CHARACTER(len=*), INTENT(in   ), OPTIONAL     & 
     476                      &               ::   cdvar    ! name of the variable 
     477      ! 
     478      INTEGER                         ::   if90id   ! temporary integer 
     479      INTEGER                         ::   ivarid   ! NetCDF variable Id 
     480      LOGICAL                         ::   llok     ! temporary logical 
     481      LOGICAL                         ::   lenddef  ! temporary logical 
     482      CHARACTER(LEN=100)              ::   clinfo   ! info character 
     483      !--------------------------------------------------------------------- 
     484      ! 
     485      if90id = iom_file(kiomid)%nfid 
     486      lenddef = .false. 
     487      IF( PRESENT(cdvar) ) THEN 
     488         ! check the variable exists in the file 
     489         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr 
     490         IF( .NOT. llok ) THEN 
     491            CALL ctl_warn('iom_nf90_putatt: no variable '//cdvar//' found') 
     492         ENDIF 
     493      ELSE 
     494         llok = .true. 
     495         ivarid = NF90_GLOBAL 
     496      ENDIF 
     497! 
     498      IF( llok) THEN 
     499         clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', piatt: '//TRIM(cdatt) 
     500         IF( iom_file(kiomid)%irec /= -1 ) THEN    
     501            ! trick: irec used to know if the file is in define mode or not 
     502            ! if it is not then temporarily put it into define mode 
     503            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo) 
     504            lenddef = .true. 
     505         ENDIF 
     506         ! 
     507         CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values=pv_i0d), clinfo) 
     508         ! 
     509         IF( lenddef ) THEN    
     510            ! file was in data mode on entry; put it back in that mode 
     511            CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo) 
     512         ENDIF 
     513      ELSE 
     514         CALL ctl_warn('iom_nf90_putatt: no attribute '//cdatt//' written') 
     515      ENDIF 
     516      ! 
     517   END SUBROUTINE iom_nf90_piatt 
     518 
     519   SUBROUTINE iom_nf90_pratt( kiomid, cdatt, pv_r0d, cdvar) 
     520      !!----------------------------------------------------------------------- 
     521      !!                  ***  ROUTINE  iom_nf90_pratt  *** 
     522      !! 
     523      !! ** Purpose : write a real attribute with NF90 
     524      !!              (either a global attribute (default) or a variable 
     525      !!               attribute if optional variable name is supplied (cdvar)) 
     526      !!----------------------------------------------------------------------- 
     527      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file 
     528      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name 
     529      REAL(wp)        , INTENT(in   ) ::   pv_r0d   ! write field 
     530      CHARACTER(len=*), INTENT(in   ), OPTIONAL     & 
     531                      &               ::   cdvar    ! name of the variable 
     532      ! 
     533      INTEGER                         ::   if90id   ! temporary integer 
     534      INTEGER                         ::   ivarid   ! NetCDF variable Id 
     535      LOGICAL                         ::   llok     ! temporary logical 
     536      LOGICAL                         ::   lenddef  ! temporary logical 
     537      CHARACTER(LEN=100)              ::   clinfo   ! info character 
     538      !--------------------------------------------------------------------- 
     539      ! 
     540      if90id = iom_file(kiomid)%nfid 
     541      lenddef = .false. 
     542      IF( PRESENT(cdvar) ) THEN 
     543         ! check the variable exists in the file 
     544         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr 
     545         IF( .NOT. llok ) THEN 
     546            CALL ctl_warn('iom_nf90_putatt: no variable '//cdvar//' found') 
     547         ENDIF 
     548      ELSE 
     549         llok = .true. 
     550         ivarid = NF90_GLOBAL 
     551      ENDIF 
     552! 
     553      IF( llok) THEN 
     554         clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', pratt: '//TRIM(cdatt) 
     555         IF( iom_file(kiomid)%irec /= -1 ) THEN    
     556            ! trick: irec used to know if the file is in define mode or not 
     557            ! if it is not then temporarily put it into define mode 
     558            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo) 
     559            lenddef = .true. 
     560         ENDIF 
     561         ! 
     562         CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values=pv_r0d), clinfo) 
     563         ! 
     564         IF( lenddef ) THEN    
     565            ! file was in data mode on entry; put it back in that mode 
     566            CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo) 
     567         ENDIF 
     568      ELSE 
     569         CALL ctl_warn('iom_nf90_putatt: no attribute '//cdatt//' written') 
     570      ENDIF 
     571      ! 
     572   END SUBROUTINE iom_nf90_pratt 
     573 
     574   SUBROUTINE iom_nf90_pcatt( kiomid, cdatt, pv_c0d, cdvar) 
     575      !!----------------------------------------------------------------------- 
     576      !!                  ***  ROUTINE  iom_nf90_pcatt  *** 
     577      !! 
     578      !! ** Purpose : write a character attribute with NF90 
     579      !!              (either a global attribute (default) or a variable 
     580      !!               attribute if optional variable name is supplied (cdvar)) 
     581      !!----------------------------------------------------------------------- 
     582      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file 
     583      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name 
     584      CHARACTER(len=*), INTENT(in   ) ::   pv_c0d   ! write field 
     585      CHARACTER(len=*), INTENT(in   ), OPTIONAL     & 
     586                      &               ::   cdvar    ! name of the variable 
     587      ! 
     588      INTEGER                         ::   if90id   ! temporary integer 
     589      INTEGER                         ::   ivarid   ! NetCDF variable Id 
     590      LOGICAL                         ::   llok     ! temporary logical 
     591      LOGICAL                         ::   lenddef  ! temporary logical 
     592      CHARACTER(LEN=100)              ::   clinfo   ! info character 
     593      !--------------------------------------------------------------------- 
     594      ! 
     595      if90id = iom_file(kiomid)%nfid 
     596      lenddef = .false. 
     597      IF( PRESENT(cdvar) ) THEN 
     598         ! check the variable exists in the file 
     599         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr 
     600         IF( .NOT. llok ) THEN 
     601            CALL ctl_warn('iom_nf90_putatt: no variable '//cdvar//' found') 
     602         ENDIF 
     603      ELSE 
     604         llok = .true. 
     605         ivarid = NF90_GLOBAL 
     606      ENDIF 
     607! 
     608      IF( llok) THEN 
     609         clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', pcatt: '//TRIM(cdatt) 
     610         IF( iom_file(kiomid)%irec /= -1 ) THEN    
     611            ! trick: irec used to know if the file is in define mode or not 
     612            ! if it is not then temporarily put it into define mode 
     613            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo) 
     614            lenddef = .true. 
     615         ENDIF 
     616         ! 
     617         CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values=pv_c0d), clinfo) 
     618         ! 
     619         IF( lenddef ) THEN    
     620            ! file was in data mode on entry; put it back in that mode 
     621            CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo) 
     622         ENDIF 
     623      ELSE 
     624         CALL ctl_warn('iom_nf90_putatt: no attribute '//cdatt//' written') 
     625      ENDIF 
     626      ! 
     627   END SUBROUTINE iom_nf90_pcatt 
    341628 
    342629 
Note: See TracChangeset for help on using the changeset viewer.