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.
module_example.F90 in NEMO/trunk/src/OCE – NEMO

source: NEMO/trunk/src/OCE/module_example.F90 @ 14233

Last change on this file since 14233 was 14041, checked in by nicolasmartin, 3 years ago

Renaming module template for syntaxe highlighting
  • Property svn:keywords set to Id
File size: 10.1 KB
RevLine 
[3]1MODULE exampl
2   !!======================================================================
[1041]3   !!                       ***  MODULE  exampl  ***
[3]4   !! Ocean physics:  brief description of the purpose of the module
5   !!                 (please no more than 2 lines)
[1041]6   !!======================================================================
7   !! History : 3.0  !  2008-06  (Author Names)  Original code
8   !!            -   !  2008-08  (Author names)  brief description of modifications
[2528]9   !!           3.3  !  2010-11  (Author names)        -              -
[1041]10   !!----------------------------------------------------------------------
[3]11#if defined key_example
12   !!----------------------------------------------------------------------
13   !!   'key_example'  :                brief description of the key option
14   !!----------------------------------------------------------------------
[4147]15   !!   exa_mpl       : list of module subroutine (caution, never use the
[1041]16   !!   exa_mpl_init  : name of the module for a routine)
17   !!   exa_mpl_stp   : Please try to use 3 letter block for routine names
[3]18   !!----------------------------------------------------------------------
[1041]19   USE module_name1   ! brief description of the used module
20   USE module_name2   ! ....
[3]21
22   IMPLICIT NONE
23   PRIVATE
24
[2737]25   PUBLIC   exa_mpl        ! routine called in xxx.F90 module
26   PUBLIC   exa_mpl_init   ! routine called in nemogcm.F90 module
[3]27
[2528]28   TYPE ::   FLD_E                !: Structure type definition
29      CHARACTER(lc) ::   clname      ! clname description (default length, lc, is 256, see par_kind.F90)
30      INTEGER       ::   nfreqh      ! nfreqh description
31   END TYPE FLD_E 
32
[2737]33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   var1         !: var1 description. CAUTION always use !: to describe
[1041]34   !                                                          !  a PUBLIC variable: simplify its search :
35   !                                                          !  grep var1 *90 | grep '!:'
[2737]36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   var2, var2   !: several variable on a same line OK, but
[1041]37   !                                                          !  DO NOT use continuation lines in declaration
[3]38
[2528]39   !                               !!* namelist nam_xxx *
40   LOGICAL   ::   ln_opt = .TRUE.   ! give the default value of each namelist parameter
41   CHARACTER ::   cn_tex = 'T'      ! short description  of the variable
42   INTEGER   ::   nn_opt = 1        ! please respect the DOCTOR norm for namelist variable
43   REAL(wp)  ::   rn_var = 2._wp    ! (it becomes easy to identify them in the code)
44   TYPE(FLD) ::   sn_ex             ! structure
[3]45
[1041]46   INTEGER                          ::   nint    ! nint  description (local permanent variable)
47   REAL(wp)                         ::   var     ! var         -                -
[2737]48   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   array   ! array       -                -
[1041]49
[3]50   !! * Substitutions
[14033]51   ! for DO macro
52#  include "do_loop_substitute.h90"
53   !for other substitutions
[3]54#  include "exampl_substitute.h90"
55   !!----------------------------------------------------------------------
[9598]56   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[1146]57   !! $Id$
[10068]58   !! Software governed by the CeCILL license (see ./LICENSE)
[3]59   !!----------------------------------------------------------------------
60CONTAINS
61
[2737]62   INTEGER FUNCTION exa_mpl_alloc()
63      !!----------------------------------------------------------------------
64      !!                ***  FUNCTION exa_mpl_alloc  ***
65      !!----------------------------------------------------------------------
66      ALLOCATE( array(jpi,jpj,jpk) , STAT= exa_mpl_alloc )   ! Module array                                                               
67      !
[10425]68      CALL mpp_sum ( 'module_example', exa_mpl_alloc )
69      IF( exa_mpl_alloc /= 0 )   CALL ctl_stop( 'STOP', 'exa_mpl_alloc: failed to allocate arrays' )
[2737]70      !
71   END FUNCTION exa_mpl_alloc
72   
73
[1041]74   SUBROUTINE exa_mpl( kt, pvar1, pvar2, ptab )
[3]75      !!----------------------------------------------------------------------
76      !!                    ***  ROUTINE exa_mpl  ***
77      !!
78      !! ** Purpose :   Brief description of the routine
79      !!
80      !! ** Method  :   description of the methodoloy used to achieve the
[1041]81      !!                objectives of the routine. Be as clear as possible!
[3]82      !!
83      !! ** Action  : - first action (share memory array/varible modified
84      !!                in this routine
85      !!              - second action .....
86      !!              - .....
87      !!
[1041]88      !! References :   Author et al., Short_name_review, Year
89      !!                Give references if exist otherwise suppress these lines
90      !!----------------------------------------------------------------------
91      INTEGER , INTENT(in   )                     ::   kt      ! short description
92      INTEGER , INTENT(inout)                     ::   pvar1   !   -         -
93      REAL(wp), INTENT(  out)                     ::   pvar2   !   -         -
94      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   pvar2   !   -         -
95      !!
96      INTEGER  ::   ji, jj, jk       ! dummy loop arguments  (DOCTOR : start with j, but not jp)
97      INTEGER  ::   itoto, itata     ! temporary integers    (DOCTOR : start with i
[13472]98      REAL(wp) ::   zmlmin, zbbrho   ! temporary scalars     (DOCTOR : start with z)
[1041]99      REAL(wp) ::   zfact1, zfact2   ! do not use continuation lines in declaration
[14033]100      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zwrk_2d   ! 2D workspace
101      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zwrk_3d   ! 3D workspace
[3]102      !!--------------------------------------------------------------------
[9019]103      !
[14033]104      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
105         IF( kt == nit000  )   CALL exa_mpl_init    ! Initialization (first time-step only)
[3]106
[14033]107         zmlmin = 1.e-8                             ! Local constant initialization
108         zbbrho =  .5 * ebb / rho0
109         zfact1 = -.5 * rdt * efave
110         zfact2 = 1.5 * rdt * ediss
111      ENDIF
112     
[1041]113      SELECT CASE ( npdl )                       ! short description of the action
114      !
115      CASE ( 0 )                                      ! describe case 1
[14033]116         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
117            avm(ji,jj,jk) = ....
118         END_3D
[1041]119         !
120      CASE ( 1 )                                      ! describe case 2
[14033]121         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
122            avm(ji,jj,jk) = ....
123         END_3D
[1041]124         !
[3]125      END SELECT
[1041]126      !
[14040]127      ! WARNING! the lbc_lnk call could not be compatible with the tiling approach
128      ! please refer to the manual for how to adapt your code
[14033]129      CALL lbc_lnk( 'module_example', avm, 'T', 1., ncsten=true )     ! Lateral boundary conditions (unchanged sign)
130      !                                                                ! ncsten=false for 5-points stencil communication
131      !                                                                ! ncsten=true (default)  for 9-points stencil communication
[2528]132      !
[3]133   END SUBROUTINE exa_mpl
134
135
136   SUBROUTINE exa_mpl_init
137      !!----------------------------------------------------------------------
138      !!                  ***  ROUTINE exa_mpl_init  ***
139      !!                   
140      !! ** Purpose :   initialization of ....
141      !!
142      !! ** Method  :   blah blah blah ...
143      !!
144      !! ** input   :   Namlist namexa
145      !!
146      !! ** Action  :   ... 
147      !!----------------------------------------------------------------------
148      INTEGER ::   ji, jj, jk, jit   ! dummy loop indices
[4147]149      INTEGER  ::   ios              ! Local integer output status for namelist read
[1041]150      !!
[2528]151      NAMELIST/namexa/ exa_v1, exa_v2, nexa_0, sn_ex     
[3]152      !!----------------------------------------------------------------------
[1041]153      !
[4147]154      REWIND( numnam_ref )              ! Namelist namexa in reference namelist : Example
155      READ  ( numnam_ref, namexa, IOSTAT = ios, ERR = 901)
[11536]156901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namexa in reference namelist' )
[9168]157      !
[4147]158      REWIND( numnam_cfg )              ! Namelist namexa in configuration namelist : Example
159      READ  ( numnam_cfg, namexa, IOSTAT = ios, ERR = 902 )
[11536]160902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namexa in configuration namelist' )
[4147]161   ! Output namelist for control
162      WRITE ( numond, namexa )
[1041]163      !
[2528]164      IF(lwp) THEN                              ! Control print
[3]165         WRITE(numout,*)
166         WRITE(numout,*) 'exa_mpl_init : example '
167         WRITE(numout,*) '~~~~~~~~~~~~'
[2528]168         WRITE(numout,*) '   Namelist namexa : set example parameters'
169         WRITE(numout,*) '      brief desciption               exa_v1  = ', exa_v1
[4147]170         WRITE(numout,*) '      brief desciption               exa_v2  = ', exa_v2
[2528]171         WRITE(numout,*) '      brief desciption               nexa_0  = ', nexa_0
172         WRITE(numout,*) '      brief desciption          sn_ex%clname = ', sn_ex%clname
173         WRITE(numout,*) '      brief desciption          sn_ex%nfreqh = ', sn_ex%nfreqh
[3]174      ENDIF
[1041]175      !
[2737]176      !                              ! allocate exa_mpl arrays     
177      IF( exa_mpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'exa_mpl_init : unable to allocate arrays' )
178      !                              ! Parameter control
[14040]179      IF( ln_tile .AND. ntile > 0 ) CALL ctl_stop( 'exa_mpl_init: tiling is not supported in this module by default, see manual for how to adapt your code' )
[2528]180      IF( ln_opt      )   CALL ctl_stop( 'exa_mpl_init: this work and option xxx are incompatible'   )
[10425]181      IF( nn_opt == 2 )   CALL ctl_stop( 'STOP',  'exa_mpl_init: this work and option yyy may cause problems'  )
[1041]182      !
[15]183   END SUBROUTINE exa_mpl_init
[3]184
185#else
186   !!----------------------------------------------------------------------
[1041]187   !!   Default option :                                         NO example
[3]188   !!----------------------------------------------------------------------
189CONTAINS
[1041]190   SUBROUTINE exa_mpl( kt, pvar1, pvar2, ptab )              ! Empty routine
191      REAL::   ptab(:,:)
192      WRITE(*,*) 'exa_mpl: You should not have seen this print! error?', kt, pvar1, pvar2, ptab(1,1)
[3]193   END SUBROUTINE exa_mpl
194#endif
195
196   !!======================================================================
197END MODULE exampl
Note: See TracBrowser for help on using the repository browser.