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 in NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE – NEMO

source: NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/module_example @ 12202

Last change on this file since 12202 was 12202, checked in by cetlod, 4 years ago

dev_merge_option2 : merge in dev_r11613_ENHANCE-04_namelists_as_internalfiles
  • Property svn:keywords set to Id
File size: 9.3 KB
Line 
1MODULE exampl
2   !!======================================================================
3   !!                       ***  MODULE  exampl  ***
4   !! Ocean physics:  brief description of the purpose of the module
5   !!                 (please no more than 2 lines)
6   !!======================================================================
7   !! History : 3.0  !  2008-06  (Author Names)  Original code
8   !!            -   !  2008-08  (Author names)  brief description of modifications
9   !!           3.3  !  2010-11  (Author names)        -              -
10   !!----------------------------------------------------------------------
11#if defined key_example
12   !!----------------------------------------------------------------------
13   !!   'key_example'  :                brief description of the key option
14   !!----------------------------------------------------------------------
15   !!   exa_mpl       : list of module subroutine (caution, never use the
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
18   !!----------------------------------------------------------------------
19   USE module_name1   ! brief description of the used module
20   USE module_name2   ! ....
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   exa_mpl        ! routine called in xxx.F90 module
26   PUBLIC   exa_mpl_init   ! routine called in nemogcm.F90 module
27
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
33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   var1         !: var1 description. CAUTION always use !: to describe
34   !                                                          !  a PUBLIC variable: simplify its search :
35   !                                                          !  grep var1 *90 | grep '!:'
36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   var2, var2   !: several variable on a same line OK, but
37   !                                                          !  DO NOT use continuation lines in declaration
38
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
45
46   INTEGER                          ::   nint    ! nint  description (local permanent variable)
47   REAL(wp)                         ::   var     ! var         -                -
48   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   array   ! array       -                -
49
50   !! * Substitutions
51#  include "exampl_substitute.h90"
52   !!----------------------------------------------------------------------
53   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
54   !! $Id$
55   !! Software governed by the CeCILL license (see ./LICENSE)
56   !!----------------------------------------------------------------------
57CONTAINS
58
59   INTEGER FUNCTION exa_mpl_alloc()
60      !!----------------------------------------------------------------------
61      !!                ***  FUNCTION exa_mpl_alloc  ***
62      !!----------------------------------------------------------------------
63      ALLOCATE( array(jpi,jpj,jpk) , STAT= exa_mpl_alloc )   ! Module array                                                               
64      !
65      CALL mpp_sum ( 'module_example', exa_mpl_alloc )
66      IF( exa_mpl_alloc /= 0 )   CALL ctl_stop( 'STOP', 'exa_mpl_alloc: failed to allocate arrays' )
67      !
68   END FUNCTION exa_mpl_alloc
69   
70
71   SUBROUTINE exa_mpl( kt, pvar1, pvar2, ptab )
72      !!----------------------------------------------------------------------
73      !!                    ***  ROUTINE exa_mpl  ***
74      !!
75      !! ** Purpose :   Brief description of the routine
76      !!
77      !! ** Method  :   description of the methodoloy used to achieve the
78      !!                objectives of the routine. Be as clear as possible!
79      !!
80      !! ** Action  : - first action (share memory array/varible modified
81      !!                in this routine
82      !!              - second action .....
83      !!              - .....
84      !!
85      !! References :   Author et al., Short_name_review, Year
86      !!                Give references if exist otherwise suppress these lines
87      !!----------------------------------------------------------------------
88      INTEGER , INTENT(in   )                     ::   kt      ! short description
89      INTEGER , INTENT(inout)                     ::   pvar1   !   -         -
90      REAL(wp), INTENT(  out)                     ::   pvar2   !   -         -
91      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   pvar2   !   -         -
92      !!
93      INTEGER  ::   ji, jj, jk       ! dummy loop arguments  (DOCTOR : start with j, but not jp)
94      INTEGER  ::   itoto, itata     ! temporary integers    (DOCTOR : start with i
95      REAL(wp) ::   zmlmin, zbbrau   ! temporary scalars     (DOCTOR : start with z)
96      REAL(wp) ::   zfact1, zfact2   ! do not use continuation lines in declaration
97      REAL(wp), DIMENSION(jpi,jpj) ::   zwrk_2d   ! 2D workspace
98      !!--------------------------------------------------------------------
99      !
100      IF( kt == nit000  )   CALL exa_mpl_init    ! Initialization (first time-step only)
101
102      zmlmin = 1.e-8                             ! Local constant initialization
103      zbbrau =  .5 * ebb / rau0
104      zfact1 = -.5 * rdt * efave
105      zfact2 = 1.5 * rdt * ediss
106
107      SELECT CASE ( npdl )                       ! short description of the action
108      !
109      CASE ( 0 )                                      ! describe case 1
110         DO jk = 2, jpkm1
111            DO jj = 2, jpjm1
112               DO ji = fs_2, fs_jpim1   ! vector opt.
113                  avm(ji,jj,jk) = ....
114               END DO
115            END DO
116         END DO
117         !
118      CASE ( 1 )                                      ! describe case 2
119         DO jk = 2, jpkm1
120            DO jj = 2, jpjm1
121               DO ji = fs_2, fs_jpim1   ! vector opt.
122                  avm(ji,jj,jk) = ...
123               END DO
124            END DO
125         END DO
126         !
127      END SELECT
128      !
129      CALL lbc_lnk( 'module_example', avm, 'T', 1. )              ! Lateral boundary conditions (unchanged sign)
130      !
131   END SUBROUTINE exa_mpl
132
133
134   SUBROUTINE exa_mpl_init
135      !!----------------------------------------------------------------------
136      !!                  ***  ROUTINE exa_mpl_init  ***
137      !!                   
138      !! ** Purpose :   initialization of ....
139      !!
140      !! ** Method  :   blah blah blah ...
141      !!
142      !! ** input   :   Namlist namexa
143      !!
144      !! ** Action  :   ... 
145      !!----------------------------------------------------------------------
146      INTEGER ::   ji, jj, jk, jit   ! dummy loop indices
147      INTEGER  ::   ios              ! Local integer output status for namelist read
148      !!
149      NAMELIST/namexa/ exa_v1, exa_v2, nexa_0, sn_ex     
150      !!----------------------------------------------------------------------
151      !
152      READ  ( numnam_ref, namexa, IOSTAT = ios, ERR = 901)
153901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namexa in reference namelist' )
154      !
155      READ  ( numnam_cfg, namexa, IOSTAT = ios, ERR = 902 )
156902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namexa in configuration namelist' )
157   ! Output namelist for control
158      WRITE ( numond, namexa )
159      !
160      IF(lwp) THEN                              ! Control print
161         WRITE(numout,*)
162         WRITE(numout,*) 'exa_mpl_init : example '
163         WRITE(numout,*) '~~~~~~~~~~~~'
164         WRITE(numout,*) '   Namelist namexa : set example parameters'
165         WRITE(numout,*) '      brief desciption               exa_v1  = ', exa_v1
166         WRITE(numout,*) '      brief desciption               exa_v2  = ', exa_v2
167         WRITE(numout,*) '      brief desciption               nexa_0  = ', nexa_0
168         WRITE(numout,*) '      brief desciption          sn_ex%clname = ', sn_ex%clname
169         WRITE(numout,*) '      brief desciption          sn_ex%nfreqh = ', sn_ex%nfreqh
170      ENDIF
171      !
172      !                              ! allocate exa_mpl arrays     
173      IF( exa_mpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'exa_mpl_init : unable to allocate arrays' )
174      !                              ! Parameter control
175      IF( ln_opt      )   CALL ctl_stop( 'exa_mpl_init: this work and option xxx are incompatible'   )
176      IF( nn_opt == 2 )   CALL ctl_stop( 'STOP',  'exa_mpl_init: this work and option yyy may cause problems'  )
177      !
178   END SUBROUTINE exa_mpl_init
179
180#else
181   !!----------------------------------------------------------------------
182   !!   Default option :                                         NO example
183   !!----------------------------------------------------------------------
184CONTAINS
185   SUBROUTINE exa_mpl( kt, pvar1, pvar2, ptab )              ! Empty routine
186      REAL::   ptab(:,:)
187      WRITE(*,*) 'exa_mpl: You should not have seen this print! error?', kt, pvar1, pvar2, ptab(1,1)
188   END SUBROUTINE exa_mpl
189#endif
190
191   !!======================================================================
192END MODULE exampl
Note: See TracBrowser for help on using the repository browser.