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 12080 for utils/tools/SIREN/src/iom_dom.f90 – NEMO

Ignore:
Timestamp:
2019-12-06T10:30:14+01:00 (4 years ago)
Author:
jpaul
Message:

update nemo trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • utils/tools/SIREN/src/iom_dom.f90

    r9598 r12080  
    22! NEMO system team, System and Interface for oceanic RElocable Nesting 
    33!---------------------------------------------------------------------- 
    4 ! 
    5 ! MODULE: iom_dom 
    64! 
    75! DESCRIPTION: 
    … …  
    2422!> @author 
    2523!> J.Paul 
    26 ! REVISION HISTORY: 
     24!> 
    2725!> @date October, 2014 - Initial Version 
    2826!> 
    29 !> @note Software governed by the CeCILL licence     (./LICENSE) 
     27!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3028!---------------------------------------------------------------------- 
    3129MODULE iom_dom 
     30 
    3231   USE netcdf                          ! nf90 library 
    3332   USE global                          ! global parameter 
    … …  
    4241   USe dom                             ! domain manager 
    4342   USE iom_mpp                         ! I/O mpp manager 
     43 
    4444   IMPLICIT NONE 
    4545   ! NOTE_avoid_public_variables_if_possible 
    … …  
    6666 
    6767CONTAINS 
     68   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     69   SUBROUTINE iom_dom_open(td_mpp, td_dom, id_perio, id_ew) 
    6870   !------------------------------------------------------------------- 
    6971   !> @brief This subroutine open files composing mpp structure  
    … …  
    7577   !> @param[inout] td_mpp mpp structure 
    7678   !------------------------------------------------------------------- 
    77    SUBROUTINE iom_dom_open(td_mpp, td_dom, id_perio, id_ew) 
     79 
    7880      IMPLICIT NONE 
     81 
    7982      ! Argument       
    8083      TYPE(TMPP) , INTENT(INOUT) :: td_mpp 
    … …  
    102105 
    103106   END SUBROUTINE iom_dom_open 
     107   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     108   SUBROUTINE iom_dom_close(td_mpp) 
    104109   !------------------------------------------------------------------- 
    105110   !> @brief This subroutine close files composing mpp structure. 
    … …  
    110115   !> @param[in] td_mpp mpp structure 
    111116   !------------------------------------------------------------------- 
    112    SUBROUTINE iom_dom_close(td_mpp) 
     117 
    113118      IMPLICIT NONE 
     119 
    114120      ! Argument       
    115121      TYPE(TMPP), INTENT(INOUT) :: td_mpp 
    … …  
    121127 
    122128   END SUBROUTINE iom_dom_close 
     129   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     130   FUNCTION iom_dom__read_var_id(td_mpp, id_varid, td_dom) & 
     131         & RESULT (tf_var) 
    123132   !------------------------------------------------------------------- 
    124133   !> @brief This function read variable value in opened mpp files, 
    … …  
    137146   !> @return  variable structure  
    138147   !------------------------------------------------------------------- 
    139    TYPE(TVAR) FUNCTION iom_dom__read_var_id(td_mpp, id_varid, td_dom ) 
     148 
    140149      IMPLICIT NONE 
     150 
    141151      ! Argument       
    142152      TYPE(TMPP) , INTENT(IN) :: td_mpp 
    143153      INTEGER(i4), INTENT(IN) :: id_varid 
    144154      TYPE(TDOM) , INTENT(IN) :: td_dom 
     155 
     156      ! function 
     157      TYPE(TVAR)              :: tf_var 
    145158 
    146159      ! local variable 
    … …  
    150163      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN 
    151164 
    152          CALL logger_error( " IOM DOM READ VAR: domain decomposition "//& 
    153          &  "not define in mpp strcuture "//TRIM(td_mpp%c_name)) 
     165         CALL logger_error(" IOM DOM READ VAR: domain decomposition "//& 
     166            &              "not define in mpp strcuture "//TRIM(td_mpp%c_name)) 
    154167 
    155168      ELSE 
    … …  
    161174            IF( il_ind(1) /= 0 )THEN 
    162175 
    163                iom_dom__read_var_id=var_copy(td_mpp%t_proc(1)%t_var(il_ind(1))) 
     176               tf_var=var_copy(td_mpp%t_proc(1)%t_var(il_ind(1))) 
    164177 
    165178               !!! read variable value 
    166                CALL iom_dom__read_var_value(td_mpp, iom_dom__read_var_id, & 
    167                &                            td_dom) 
     179               CALL iom_dom__read_var_value(td_mpp, tf_var, td_dom) 
    168180 
    169181            ELSE 
    170182               CALL logger_error( & 
    171                &  " IOM DOM READ VAR: there is no variable with id "//& 
    172                &  TRIM(fct_str(id_varid))//" in processor/file "//& 
    173                &  TRIM(td_mpp%t_proc(1)%c_name)) 
     183                  &  " IOM DOM READ VAR: there is no variable with id "//& 
     184                  &  TRIM(fct_str(id_varid))//" in processor/file "//& 
     185                  &  TRIM(td_mpp%t_proc(1)%c_name)) 
    174186            ENDIF 
    175187         ELSE 
    176188            CALL logger_error(" IOM DOM READ VAR: can't read variable, mpp "//& 
    177             &  TRIM(td_mpp%c_name)//" not opened") 
     189               &              TRIM(td_mpp%c_name)//" not opened") 
    178190         ENDIF 
    179191 
    … …  
    181193 
    182194   END FUNCTION iom_dom__read_var_id 
     195   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     196   FUNCTION iom_dom__read_var_name(td_mpp, cd_name, td_dom) & 
     197         & RESULT (tf_var) 
    183198   !------------------------------------------------------------------- 
    184199   !> @brief This function read variable value in opened mpp files,  
    … …  
    192207   !> exist in file, look for variable standard name.<br/> 
    193208   !> If variable name is not present, check variable standard name.<br/> 
    194    ! 
    195    !> @author J.Paul 
    196    !> @date October, 2014 - Initial Version 
    197    ! 
     209   !> 
     210   !> @author J.Paul 
     211   !> @date October, 2014 - Initial Version 
     212   !> @date May, 2019 
     213   !> - copy variable struct without array of value, then read array of value. 
     214   !> 
    198215   !> @param[in] td_mpp    mpp structure 
    199216   !> @param[in] cd_name   variable name 
    … …  
    201218   !> @return  variable structure  
    202219   !------------------------------------------------------------------- 
    203    TYPE(TVAR) FUNCTION iom_dom__read_var_name(td_mpp, cd_name, td_dom ) 
     220 
    204221      IMPLICIT NONE 
     222 
    205223      ! Argument       
    206224      TYPE(TMPP),       INTENT(IN) :: td_mpp 
    … …  
    208226      TYPE(TDOM)      , INTENT(IN) :: td_dom 
    209227 
     228      ! function 
     229      TYPE(TVAR)                   :: tf_var 
     230 
    210231      ! local variable 
    211232      INTEGER(i4)       :: il_ind 
    … …  
    216237 
    217238         CALL logger_error( " IOM DOM READ VAR: domain decomposition not define "//& 
    218          &               " in mpp strcuture "//TRIM(td_mpp%c_name)) 
     239            &               " in mpp strcuture "//TRIM(td_mpp%c_name)) 
    219240 
    220241      ELSE 
    221242 
    222             il_ind=var_get_index( td_mpp%t_proc(1)%t_var(:), cd_name) 
    223             IF( il_ind /= 0 )THEN 
    224  
    225                iom_dom__read_var_name=var_copy(td_mpp%t_proc(1)%t_var(il_ind)) 
    226  
    227                !!! read variable value 
    228                CALL iom_dom__read_var_value( td_mpp, & 
    229                &                             iom_dom__read_var_name, & 
    230                &                             td_dom ) 
    231  
    232             ELSE 
    233  
    234                CALL logger_error( & 
     243         il_ind=var_get_index( td_mpp%t_proc(1)%t_var(:), cd_name) 
     244         IF( il_ind /= 0 )THEN 
     245 
     246            tf_var=var_copy(td_mpp%t_proc(1)%t_var(il_ind), ld_value=.FALSE.) 
     247 
     248            !!! read variable value 
     249            CALL iom_dom__read_var_value( td_mpp, tf_var, td_dom ) 
     250 
     251         ELSE 
     252 
     253            CALL logger_error( & 
    235254               &  " IOM DOM READ VAR: there is no variable with "//& 
    236255               &  "name or standard name "//TRIM(cd_name)//& 
    237256               &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name)) 
    238             ENDIF 
     257         ENDIF 
    239258 
    240259      ENDIF 
    241260  
    242261   END FUNCTION iom_dom__read_var_name 
     262   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     263   SUBROUTINE iom_dom__read_var_value(td_mpp, td_var, td_dom) 
    243264   !------------------------------------------------------------------- 
    244265   !> @brief This subroutine read variable value 
    … …  
    255276   !> @param[in] td_dom    domain structure 
    256277   !------------------------------------------------------------------- 
    257    SUBROUTINE iom_dom__read_var_value(td_mpp, td_var, td_dom ) 
     278 
    258279      IMPLICIT NONE 
     280 
    259281      ! Argument       
    260282      TYPE(TMPP),   INTENT(IN)    :: td_mpp 
    … …  
    263285 
    264286      ! local variable 
    265       INTEGER(i4)                       :: il_status 
    266  
    267       TYPE(TATT)                        :: tl_att 
    268       TYPE(TMPP)                        :: tl_mpp 
    269       TYPE(TDOM)                        :: tl_dom 
     287      INTEGER(i4)                 :: il_status 
     288 
     289      TYPE(TATT)                  :: tl_att 
     290      TYPE(TMPP)                  :: tl_mpp 
     291      TYPE(TDOM)                  :: tl_dom 
    270292 
    271293      ! loop indices 
    272       INTEGER(i4)                       :: jk 
     294      INTEGER(i4)                 :: jk 
    273295      !---------------------------------------------------------------- 
    274296 
    … …  
    403425 
    404426   END SUBROUTINE iom_dom__read_var_value 
     427   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     428   SUBROUTINE iom_dom__no_pole_no_overlap(td_mpp, td_var, td_dom) 
    405429   !------------------------------------------------------------------- 
    406430   !> @brief This subroutine read variable value 
    … …  
    412436   !> @author J.Paul 
    413437   !> @date October, 2014 - Initial Version 
    414    ! 
     438   !> 
    415439   !> @param[in] td_mpp    mpp structure 
    416440   !> @param[inout] td_var variable structure 
    417441   !> @param[in] td_dom    domain structure 
    418442   !------------------------------------------------------------------- 
    419    SUBROUTINE iom_dom__no_pole_no_overlap(td_mpp, td_var, td_dom ) 
     443 
    420444      IMPLICIT NONE 
     445 
    421446      ! Argument       
    422447      TYPE(TMPP),  INTENT(IN)    :: td_mpp 
    … …  
    457482 
    458483   END SUBROUTINE iom_dom__no_pole_no_overlap 
     484   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     485   SUBROUTINE iom_dom__no_pole_cyclic(td_mpp, td_var, td_dom) 
    459486   !------------------------------------------------------------------- 
    460487   !> @brief This subroutine read cyclic variable value 
    … …  
    471498   !> @param[in] td_dom    domain structure 
    472499   !------------------------------------------------------------------- 
    473    SUBROUTINE iom_dom__no_pole_cyclic(td_mpp, td_var, td_dom ) 
     500 
    474501      IMPLICIT NONE 
     502 
    475503      ! Argument       
    476504      TYPE(TMPP),   INTENT(IN   ) :: td_mpp 
    … …  
    516544 
    517545   END SUBROUTINE iom_dom__no_pole_cyclic 
     546   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     547   SUBROUTINE iom_dom__no_pole_overlap(td_mpp, td_var, td_dom) 
    518548   !------------------------------------------------------------------- 
    519549   !> @brief This subroutine read East West overlap variable value 
    … …  
    530560   !> @param[in] td_dom    domain structure 
    531561   !------------------------------------------------------------------- 
    532    SUBROUTINE iom_dom__no_pole_overlap(td_mpp, td_var, td_dom ) 
     562 
    533563      IMPLICIT NONE 
     564 
    534565      ! Argument       
    535566      TYPE(TMPP),   INTENT(IN)    :: td_mpp 
    … …  
    628659 
    629660   END SUBROUTINE iom_dom__no_pole_overlap 
     661   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     662!   SUBROUTINE iom_dom__pole_no_overlap(td_mpp, td_var, td_dom) 
    630663   !------------------------------------------------------------------- 
    631664   !> @brief This subroutine read north fold variable value 
    … …  
    637670   !> @author J.Paul 
    638671   !> @date October, 2014 - Initial Version 
    639    ! 
     672   !> 
    640673   !> @param[in] td_mpp    mpp structure 
    641674   !> @param[inout] td_var variable structure 
    642675   !> @param[in] td_dom    domain structure 
    643676   !------------------------------------------------------------------- 
    644 !   SUBROUTINE iom_dom__pole_no_overlap(td_mpp, td_var, td_dom ) 
     677! 
    645678!      IMPLICIT NONE 
     679! 
    646680!      ! Argument       
    647681!      TYPE(TMPP),   INTENT(IN)    :: td_mpp 
    … …  
    655689! 
    656690!   END SUBROUTINE iom_dom__pole_no_overlap 
     691   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     692!   SUBROUTINE iom_dom__pole_cyclic(td_mpp, td_var, td_dom) 
    657693   !------------------------------------------------------------------- 
    658694   !> @brief This subroutine read semi global variable value 
    … …  
    664700   !> @author J.Paul 
    665701   !> @date October, 2014 - Initial Version 
    666    ! 
     702   !> 
    667703   !> @param[in] td_mpp    mpp structure 
    668704   !> @param[inout] td_var variable structure 
    … …  
    670706   !> @return variable structure completed  
    671707   !------------------------------------------------------------------- 
    672 !   SUBROUTINE iom_dom__pole_cyclic(td_mpp, td_var, td_dom ) 
     708! 
    673709!      IMPLICIT NONE 
     710! 
    674711!      ! Argument       
    675712!      TYPE(TMPP),   INTENT(IN)    :: td_mpp 
    … …  
    683720! 
    684721!   END SUBROUTINE iom_dom__pole_cyclic 
     722   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     723!   SUBROUTINE iom_dom__pole_overlap(td_mpp, td_var, td_dom) 
    685724   !------------------------------------------------------------------- 
    686725   !> @brief This subroutine read north fold East West overlap variable value 
    … …  
    692731   !> @author J.Paul 
    693732   !> @date October, 2014 - Initial Version 
    694    ! 
     733   !> 
    695734   !> @param[in] td_mpp    mpp structure 
    696735   !> @param[inout] td_var variable structure 
    … …  
    698737   !> @return variable structure completed  
    699738   !------------------------------------------------------------------- 
    700 !   SUBROUTINE iom_dom__pole_overlap(td_mpp, td_var, td_dom ) 
     739! 
    701740!      IMPLICIT NONE 
     741! 
    702742!      ! Argument       
    703743!      TYPE(TMPP),   INTENT(IN)    :: td_mpp 
    … …  
    711751! 
    712752!   END SUBROUTINE iom_dom__pole_overlap 
    713  
     753   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    714754END MODULE iom_dom 
Note: See TracChangeset for help on using the changeset viewer.