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 1993 for branches/DEV_r1879_FCM/NEMOGCM/EXTERNAL/IOIPSL/src/fliocom.f90 – NEMO

Ignore:
Timestamp:
2010-07-08T15:42:43+02:00 (14 years ago)
Author:
smasson
Message:

merging IOIPSL/v2_2_1 into the EXTERNAL deposit

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/DEV_r1879_FCM/NEMOGCM/EXTERNAL/IOIPSL/src/fliocom.f90

    r1895 r1993  
    11MODULE fliocom 
    22!- 
    3 !$Id: fliocom.f90 386 2008-09-04 08:38:48Z bellier $ 
     3!$Id: fliocom.f90 965 2010-04-07 08:38:54Z bellier $ 
    44!- 
    55! This software is governed by the CeCILL license 
    … …  
    1212 &                    ioconf_calendar,ju2ymds,ymds2ju 
    1313USE errioipsl, ONLY : ipslerr,ipsldbg 
    14 USE stringop,  ONLY : strlowercase 
     14USE stringop,  ONLY : strlowercase,str_xfw 
    1515!- 
    1616IMPLICIT NONE 
    … …  
    8686!!              This argument can be equal to FLIO_DOM_DEFAULT 
    8787!!              (see "flio_dom_defset"). 
    88 !! (C) mode   : Mode used to create the file. 
    89 !!              Supported modes : REPLACE, REP, 32, 64, REP32, REP64. 
    90 !!              If this argument is present with the value "REP[32/64]" 
    91 !!              or the value "REPLACE", the file will be created 
    92 !!              in mode "CLOBBER", else the file will be created 
    93 !!              in mode "NOCLOBBER". 
     88!! (C) mode   : String of (case insensitive) blank-separated words 
     89!!              defining the mode used to create the file. 
     90!!              Supported keywords : REPLACE, 32, 64 
     91!!              If this argument is present with the keyword "REPLACE", 
     92!!              the file will be created in mode "CLOBBER", 
     93!!              else the file will be created in mode "NOCLOBBER". 
    9494!!              "32/64" defines the offset mode. 
    95 !!              The default offset mode is 32 bits. 
     95!!              The default offset mode is 64 bits. 
     96!!              Keywords "NETCDF4" and "CLASSIC" are reserved 
     97!!              for future use. 
    9698!! 
    9799!! Optional OUTPUT arguments 
    … …  
    205207!! SUBROUTINE fliodefv & 
    206208!! & (f_i,v_n,[v_d],v_t, & 
    207 !! &  axis,standard_name,long_name,units,valid_min,valid_max) 
     209!! &  axis,standard_name,long_name,units, & 
     210!! &  valid_min,valid_max,fillvalue) 
    208211!! 
    209212!! INPUT 
    … …  
    227230!! (C) axis,standard_name,long_name,units : Attributes 
    228231!!     (axis should be used only for coordinates) 
    229 !! (R) valid_min,valid_max : Attributes 
     232!! (R) valid_min,valid_max,fillvalue : Attributes 
    230233!!-------------------------------------------------------------------- 
    231234  MODULE PROCEDURE & 
    … …  
    805808!- 
    806809! Maximum number of simultaneously defined domains 
    807   INTEGER,PARAMETER :: dom_max_nb=10 
     810  INTEGER,PARAMETER :: dom_max_nb=64 
    808811!- 
    809812! Maximum number of distributed dimensions for each domain 
    … …  
    848851  INTEGER :: i_rc,f_e,idid,ii,m_c,n_u 
    849852  CHARACTER(LEN=NF90_MAX_NAME) :: f_nw 
     853  INTEGER,PARAMETER :: l_string=80,l_word=10 
     854  CHARACTER(LEN=l_string) :: c_string 
     855  CHARACTER(LEN=l_word)   :: c_word 
     856  LOGICAL :: l_ok 
     857  INTEGER,PARAMETER :: k_replace=1 
     858  INTEGER,PARAMETER :: k_32=1,k_64=2 
     859!- !? : Code to be activated for NETCDF4 
     860!?  INTEGER,PARAMETER :: k_netcdf4=1,k_classic=1 
     861  INTEGER,PARAMETER :: n_opt=4 
     862  INTEGER,DIMENSION(n_opt) :: i_opt 
    850863!- 
    851864  LOGICAL :: l_dbg 
    … …  
    881894!- 
    882895! Check the mode 
     896!- 
     897  i_opt(:)=-1 
     898!- 
    883899  IF (PRESENT(mode)) THEN 
    884     SELECT CASE (TRIM(mode)) 
    885     CASE('REPLACE','REP','REP32') 
    886       m_c = NF90_CLOBBER 
    887     CASE('32') 
    888       m_c = NF90_NOCLOBBER 
    889     CASE('64') 
    890       m_c = IOR(NF90_NOCLOBBER,NF90_64BIT_OFFSET) 
    891     CASE('REP64') 
    892       m_c = IOR(NF90_CLOBBER,NF90_64BIT_OFFSET) 
    893     CASE DEFAULT 
    894       m_c = NF90_NOCLOBBER 
    895     END SELECT 
     900!--- 
     901    IF (LEN_TRIM(mode) > l_string) THEN 
     902      CALL ipslerr (3,'fliocrfd', & 
     903 &     '"mode" argument','too long','to be treated') 
     904    ENDIF 
     905    c_string = mode(:) 
     906    CALL strlowercase (c_string) 
     907!--- 
     908    DO 
     909      CALL str_xfw  (c_string,c_word,l_ok) 
     910      IF (l_ok) THEN 
     911!- !? : Code to be activated for NETCDF4 
     912        SELECT CASE (TRIM(c_word)) 
     913        CASE('replace') 
     914          IF (i_opt(1) > 0) THEN 
     915            CALL ipslerr (3,'fliocrfd', & 
     916 &           'Replace option','already','defined') 
     917          ELSE 
     918            i_opt(1) = k_replace 
     919          ENDIF 
     920!?      CASE('netcdf4') 
     921!?        IF (i_opt(2) > 0) THEN 
     922!?          CALL ipslerr (3,'fliocrfd', & 
     923!? &         'Netcdf4 format','already','defined') 
     924!?        ELSE 
     925!?          i_opt(2) = k_netcdf4 
     926!?        ENDIF 
     927        CASE('32') 
     928          IF (i_opt(3) > 0) THEN 
     929            CALL ipslerr (3,'fliocrfd', & 
     930 &           'Offset format','already','defined') 
     931          ELSE 
     932            i_opt(3) = k_32 
     933          ENDIF 
     934        CASE('64') 
     935          IF (i_opt(3) > 0) THEN 
     936            CALL ipslerr (3,'fliocrfd', & 
     937 &           'Offset format','already','defined') 
     938          ELSE 
     939            i_opt(3) = k_64 
     940          ENDIF 
     941!?      CASE('CLASSIC') 
     942!?        IF (i_opt(4) > 0) THEN 
     943!?          CALL ipslerr (3,'fliocrfd', & 
     944!? &         'Netcdf4 classic format','already','defined') 
     945!?        ELSE 
     946!?          i_opt(4) = k_classic 
     947!?        ENDIF 
     948        CASE DEFAULT 
     949          CALL ipslerr (3,'fliocrfd', & 
     950 &         'Option '//TRIM(c_word),'not','supported') 
     951        END SELECT 
     952      ELSE 
     953        EXIT 
     954      ENDIF 
     955    ENDDO 
     956  ENDIF 
     957!- 
     958  IF (i_opt(1) == k_replace) THEN 
     959    m_c = NF90_CLOBBER 
    896960  ELSE 
    897961    m_c = NF90_NOCLOBBER 
    898962  ENDIF 
     963!- 
     964!- Code to be replaced by the following for NETCDF4 
     965!?  IF (i_opt(2) == k_netcdf4) THEN 
     966!?    m_c = IOR(m_c,NF90_NETCDF4) 
     967!?    IF (i_opt(3) > 0) THEN 
     968!?      CALL ipslerr (3,'fliocrfd', & 
     969!? &     'Netcdf4 format','and offset option','are not compatible') 
     970!?    ELSE IF (i_opt(4) == k_classic) THEN 
     971!?      m_c = IOR(m_c,NF90_CLASSIC_MODEL) 
     972!?    ENDIF 
     973!?   LSE IF (i_opt(4) > 0) THEN 
     974!?    CALL ipslerr (3,'fliocrfd', & 
     975!? &   'Classic option','is reserved','for the Netcdf4 format') 
     976!?  ELSE 
     977    IF (i_opt(3) /= k_32) THEN 
     978      m_c = IOR(m_c,NF90_64BIT_OFFSET) 
     979    ENDIF 
     980!?  ENDIF 
    899981!- 
    900982! Create file (and enter the definition mode) 
    … …  
    12291311! Ensuring data mode 
    12301312!- 
    1231     CALL flio_hdm (f_i,f_e,.FALSE.) 
     1313  CALL flio_hdm (f_i,f_e,.FALSE.) 
    12321314!- 
    12331315! Create the longitude axis 
    … …  
    12871369SUBROUTINE fliodv_r0d & 
    12881370 & (f_i,v_n,v_t, & 
    1289  &  axis,standard_name,long_name,units,valid_min,valid_max) 
     1371 &  axis,standard_name,long_name,units,valid_min,valid_max,fillvalue) 
    12901372!--------------------------------------------------------------------- 
    12911373  IMPLICIT NONE 
    … …  
    12961378  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: & 
    12971379 & axis,standard_name,long_name,units 
    1298   REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max 
     1380  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max,fillvalue 
    12991381!--------------------------------------------------------------------- 
    13001382  CALL flio_udv & 
    13011383 &  (f_i,0,v_n,(/0/),v_t, & 
    1302  &   axis,standard_name,long_name,units,valid_min,valid_max) 
     1384 &   axis,standard_name,long_name,units,valid_min,valid_max,fillvalue) 
    13031385!------------------------ 
    13041386END SUBROUTINE fliodv_r0d 
    … …  
    13061388SUBROUTINE fliodv_rnd & 
    13071389 & (f_i,v_n,v_d,v_t, & 
    1308  &  axis,standard_name,long_name,units,valid_min,valid_max) 
     1390 &  axis,standard_name,long_name,units,valid_min,valid_max,fillvalue) 
    13091391!--------------------------------------------------------------------- 
    13101392  IMPLICIT NONE 
    … …  
    13161398  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: & 
    13171399 & axis,standard_name,long_name,units 
    1318   REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max 
     1400  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max,fillvalue 
    13191401!--------------------------------------------------------------------- 
    13201402  CALL flio_udv & 
    13211403 &  (f_i,SIZE(v_d),v_n,v_d,v_t, & 
    1322  &   axis,standard_name,long_name,units,valid_min,valid_max) 
     1404 &   axis,standard_name,long_name,units,valid_min,valid_max,fillvalue) 
    13231405!------------------------ 
    13241406END SUBROUTINE fliodv_rnd 
    … …  
    13261408SUBROUTINE flio_udv & 
    13271409 & (f_i,n_d,v_n,v_d,v_t, & 
    1328  &  axis,standard_name,long_name,units,valid_min,valid_max) 
     1410 &  axis,standard_name,long_name,units,valid_min,valid_max,fillvalue) 
    13291411!--------------------------------------------------------------------- 
    13301412  IMPLICIT NONE 
    … …  
    13361418  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: & 
    13371419 & axis,standard_name,long_name,units 
    1338   REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max 
     1420  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max,fillvalue 
    13391421!- 
    13401422  INTEGER :: f_e,m_k,i_v,i_rc,ii,idd 
    … …  
    13801462!--- 
    13811463    IF (PRESENT(v_t)) THEN 
    1382       IF      (v_t == flio_i) THEN 
     1464      SELECT CASE (v_t) 
     1465      CASE(flio_i) 
    13831466        IF (i_std == i_8) THEN 
    1384 !-------- Not yet supported by NETCDF 
     1467!-------- I8 not yet supported by NETCDF 
    13851468!-------- m_k = flio_i8 
    13861469          m_k = flio_i4 
    … …  
    13881471          m_k = flio_i4 
    13891472        ENDIF 
    1390       ELSE IF (v_t == flio_r) THEN 
     1473      CASE(flio_r) 
    13911474        IF (r_std == r_8) THEN 
    13921475          m_k = flio_r8 
    … …  
    13941477          m_k = flio_r4 
    13951478        ENDIF 
    1396       ELSE 
     1479      CASE(flio_c,flio_i1,flio_i2,flio_i4,flio_r4,flio_r8) 
    13971480        m_k = v_t 
    1398       ENDIF 
     1481      CASE DEFAULT 
     1482        CALL ipslerr (3,'fliodefv', & 
     1483 &        'Variable '//TRIM(v_n),'External type','not supported') 
     1484      END SELECT 
    13991485    ELSE IF (r_std == r_8) THEN 
    14001486      m_k = flio_r8 
    … …  
    14021488      m_k = flio_r4 
    14031489    ENDIF 
     1490!--- 
    14041491    IF (n_d > 0) THEN 
    14051492      i_rc = NF90_DEF_VAR(f_e,v_n,m_k,a_i(1:n_d),i_v) 
    … …  
    14271514    ENDIF 
    14281515    IF (PRESENT(valid_min)) THEN 
    1429       i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',valid_min) 
     1516      SELECT CASE (m_k) 
     1517      CASE(flio_i1,flio_i2) 
     1518        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',NINT(valid_min,KIND=i_2)) 
     1519      CASE(flio_i4) 
     1520        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',NINT(valid_min,KIND=i_4)) 
     1521      CASE(flio_r4) 
     1522        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',REAL(valid_min,KIND=r_4)) 
     1523      CASE(flio_r8) 
     1524        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',REAL(valid_min,KIND=r_8)) 
     1525      CASE DEFAULT 
     1526        CALL ipslerr (2,'fliodefv', & 
     1527   &      'Variable '//TRIM(v_n),'attribute valid_min', & 
     1528   &      'not supported for this external type') 
     1529      END SELECT 
    14301530    ENDIF 
    14311531    IF (PRESENT(valid_max)) THEN 
    1432       i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',valid_max) 
     1532      SELECT CASE (m_k) 
     1533      CASE(flio_i1,flio_i2) 
     1534        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',NINT(valid_max,KIND=i_2)) 
     1535      CASE(flio_i4) 
     1536        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',NINT(valid_max,KIND=i_4)) 
     1537      CASE(flio_r4) 
     1538        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',REAL(valid_max,KIND=r_4)) 
     1539      CASE(flio_r8) 
     1540        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',REAL(valid_max,KIND=r_8)) 
     1541      CASE DEFAULT 
     1542        CALL ipslerr (2,'fliodefv', & 
     1543   &      'Variable '//TRIM(v_n),'attribute valid_max', & 
     1544   &      'not supported for this external type') 
     1545      END SELECT 
     1546    ENDIF 
     1547    IF (PRESENT(fillvalue)) THEN 
     1548      SELECT CASE (m_k) 
     1549      CASE(flio_i1,flio_i2) 
     1550        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',NINT(fillvalue,KIND=i_2)) 
     1551      CASE(flio_i4) 
     1552        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',NINT(fillvalue,KIND=i_4)) 
     1553      CASE(flio_r4) 
     1554        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',REAL(fillvalue,KIND=r_4)) 
     1555      CASE(flio_r8) 
     1556        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',REAL(fillvalue,KIND=r_8)) 
     1557      CASE DEFAULT 
     1558        CALL ipslerr (2,'fliodefv', & 
     1559   &      'Variable '//TRIM(v_n),'attribute fillvalue', & 
     1560   &      'not supported for this external type') 
     1561      END SELECT 
    14331562    ENDIF 
    14341563!--- 
    … …  
    21772306!- 
    21782307  IF (PRESENT(mode)) THEN 
    2179     IF (TRIM(MODE) == "WRITE") THEN 
     2308    IF (TRIM(mode) == "WRITE") THEN 
    21802309      m_c = NF90_WRITE 
    21812310    ELSE 
    … …  
    48935022  INTEGER :: kv,k,n_r,l_d,n_d,i_rc,dimnb 
    48945023  CHARACTER(LEN=1)  :: c_ax 
    4895   CHARACTER(LEN=9) :: c_sn 
     5024  CHARACTER(LEN=18) :: c_sn 
    48965025  CHARACTER(LEN=15),DIMENSION(10) :: c_r 
    48975026  CHARACTER(LEN=40) :: c_t1,c_t2 
Note: See TracChangeset for help on using the changeset viewer.