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 branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC – NEMO

source: branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/module_example @ 4616

Last change on this file since 4616 was 4616, checked in by gm, 10 years ago

#1260 : see the associated wiki page for explanation
  • Property svn:keywords set to Id
File size: 10.4 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   USE in_out_manager ! I/O manager
23   USE prtctl         ! Print control
24   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
25   USE lib_mpp        ! MPP library
26   USE wrk_nemo       ! Memory Allocation
27   USE timing         ! Timing
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   exa_mpl        ! routine called in xxx.F90 module
33   PUBLIC   exa_mpl_init   ! routine called in nemogcm.F90 module
34
35   TYPE ::   FLD_E                !: Structure type definition
36      CHARACTER(lc) ::   clname      ! clname description (default length, lc, is 256, see par_kind.F90)
37      INTEGER       ::   nfreqh      ! nfreqh description
38   END TYPE FLD_E
39
40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   var1         !: var1 description. CAUTION always use !: to describe
41   !                                                          !  a PUBLIC variable: simplify its search :
42   !                                                          !  grep var1 *90 | grep '!:'
43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   var2, var2   !: several variable on a same line OK, but
44   !                                                          !  DO NOT use continuation lines in declaration
45
46   !                               !!* namelist nam_xxx *
47   LOGICAL   ::   ln_opt = .TRUE.   ! give the default value of each namelist parameter
48   CHARACTER ::   cn_tex = 'T'      ! short description  of the variable
49   INTEGER   ::   nn_opt = 1        ! please respect the DOCTOR norm for namelist variable
50   REAL(wp)  ::   rn_var = 2._wp    ! (it becomes easy to identify them in the code)
51   TYPE(FLD) ::   sn_ex             ! structure
52
53   INTEGER                          ::   nint    ! nint  description (local permanent variable)
54   REAL(wp)                         ::   var     ! var         -                -
55   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   array   ! array       -                -
56
57   !! * Substitutions
58#  include "exampl_substitute.h90"
59   !!----------------------------------------------------------------------
60   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
61   !! $Id$
62   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
63   !!----------------------------------------------------------------------
64CONTAINS
65
66   INTEGER FUNCTION exa_mpl_alloc()
67      !!----------------------------------------------------------------------
68      !!                ***  FUNCTION exa_mpl_alloc  ***
69      !!----------------------------------------------------------------------
70      ALLOCATE( array(jpi,jpj,jpk) , STAT= exa_mpl_alloc )   ! Module array                                                               
71      !
72      IF( lk_mpp             )   CALL mpp_sum ( exa_mpl_alloc )
73      IF( exa_mpl_alloc /= 0 )   CALL ctl_warn('exa_mpl_alloc: failed to allocate arrays')
74      !
75   END FUNCTION exa_mpl_alloc
76   
77
78   SUBROUTINE exa_mpl( kt, pvar1, pvar2, ptab )
79      !!----------------------------------------------------------------------
80      !!                    ***  ROUTINE exa_mpl  ***
81      !!
82      !! ** Purpose :   Brief description of the routine
83      !!
84      !! ** Method  :   description of the methodoloy used to achieve the
85      !!                objectives of the routine. Be as clear as possible!
86      !!
87      !! ** Action  : - first action (share memory array/varible modified
88      !!                in this routine
89      !!              - second action .....
90      !!              - .....
91      !!
92      !! References :   Author et al., Short_name_review, Year
93      !!                Give references if exist otherwise suppress these lines
94      !!----------------------------------------------------------------------
95      USE toto_module      ! description of the module
96      !
97      INTEGER , INTENT(in   )                     ::   kt      ! short description
98      INTEGER , INTENT(inout)                     ::   pvar1   !   -         -
99      REAL(wp), INTENT(  out)                     ::   pvar2   !   -         -
100      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   pvar2   !   -         -
101      !
102      INTEGER  ::   ji, jj, jk       ! dummy loop arguments  (DOCTOR : start with j, but not jp)
103      INTEGER  ::   itoto, itata     ! temporary integers    (DOCTOR : start with i
104      REAL(wp) ::   zmlmin, zbbrau   ! temporary scalars     (DOCTOR : start with z)
105      REAL(wp) ::   zfact1, zfact2   ! do not use continuation lines in declaration
106      REAL(wp), POINTER, DIMENSION(:,:,:  ) ::  zwrku, zwrkv     ! 2D workspace as pointers
107      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zavm, zavt       ! 3D workspace as pointers
108      !!--------------------------------------------------------------------
109
110      IF( nn_timing == 1 )   CALL timing_start('exa_mpl')
111
112      CALL wrk_alloc( jpi, jpj, jpk, zavm , zavt  )         ! assign workspace pointers to already allocated arrays
113      CALL wrk_alloc( jpi, jpj     , zwrku, zwrkv )
114
115      IF( kt == nit000  )   CALL exa_mpl_init    ! Initialization (first time-step only)
116
117      zmlmin = 1.e-8                             ! Local constant initialization
118      zbbrau =  .5 * ebb / rau0
119      zfact1 = -.5 * rdt * efave
120      zfact2 = 1.5 * rdt * ediss
121
122      SELECT CASE ( npdl )                       ! short description of the action
123      !
124      CASE ( 0 )                                      ! describe case 1
125         DO jk = 2, jpkm1
126            DO jj = 2, jpjm1
127               DO ji = fs_2, fs_jpim1   ! vector opt.
128                  avmv(ji,jj,jk) = ....
129               END DO
130            END DO
131         END DO
132         !
133      CASE ( 1 )                                      ! describe case 2
134         DO jk = 2, jpkm1
135            DO jj = 2, jpjm1
136               DO ji = fs_2, fs_jpim1   ! vector opt.
137                  avmv(ji,jj,jk) = ...
138               END DO
139            END DO
140         END DO
141         !
142      END SELECT
143      !
144      CALL mpplnk2( avmu, 'U', 1. )              ! Lateral boundary conditions (unchanged sign)
145      !
146      CALL wrk_dealloc( jpi, jpj, jpk,       zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )
147      CALL wrk_dealloc( jpi, jpj, jpk, jpts, zlu_uu, zlv_vv, zlu_uv, zlv_vu                               )
148      !
149      IF( nn_timing == 1 )  CALL timing_stop('dyn_adv_ubs')
150      !
151   END SUBROUTINE exa_mpl
152
153
154   SUBROUTINE exa_mpl_init
155      !!----------------------------------------------------------------------
156      !!                  ***  ROUTINE exa_mpl_init  ***
157      !!                   
158      !! ** Purpose :   initialization of ....
159      !!
160      !! ** Method  :   blah blah blah ...
161      !!
162      !! ** input   :   Namlist namexa
163      !!
164      !! ** Action  :   ... 
165      !!----------------------------------------------------------------------
166      INTEGER ::   ji, jj, jk, jit   ! dummy loop indices
167      INTEGER ::   ios               ! Local integer output status for namelist read
168      !
169      NAMELIST/namexa/ exa_v1, exa_v2, nexa_0, sn_ex     
170      !!----------------------------------------------------------------------
171      !
172      REWIND( numnam_ref )             ! Namelist namexa in reference namelist : Example
173      READ  ( numnam_ref, namexa, IOSTAT = ios, ERR = 901)
174901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namexa in reference namelist', lwp )
175      !
176      REWIND( numnam_cfg )             ! Namelist namexa in configuration namelist : Example
177      READ  ( numnam_cfg, namexa, IOSTAT = ios, ERR = 902 )
178902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namexa in configuration namelist', lwp )
179      !
180      WRITE ( numond, namexa )         ! Output namelist for control
181
182      !
183      IF(lwp) THEN                              ! Control print
184         WRITE(numout,*)
185         WRITE(numout,*) 'exa_mpl_init : example '
186         WRITE(numout,*) '~~~~~~~~~~~~'
187         WRITE(numout,*) '   Namelist namexa : set example parameters'
188         WRITE(numout,*) '      brief desciption               exa_v1  = ', exa_v1
189         WRITE(numout,*) '      brief desciption               exa_v2  = ', exa_v2
190         WRITE(numout,*) '      brief desciption               nexa_0  = ', nexa_0
191         WRITE(numout,*) '      brief desciption          sn_ex%clname = ', sn_ex%clname
192         WRITE(numout,*) '      brief desciption          sn_ex%nfreqh = ', sn_ex%nfreqh
193      ENDIF
194      !
195      !                              ! allocate exa_mpl arrays     
196      IF( exa_mpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'exa_mpl_init : unable to allocate arrays' )
197      !                              ! Parameter control
198      IF( ln_opt      )   CALL ctl_stop( 'exa_mpl_init: this work and option xxx are incompatible'   )
199      IF( nn_opt == 2 )   CALL ctl_warn( 'exa_mpl_init: this work and option yyy may cause problems' )
200      !
201   END SUBROUTINE exa_mpl_init
202
203#else
204   !!----------------------------------------------------------------------
205   !!   Default option :                                         NO example
206   !!----------------------------------------------------------------------
207CONTAINS
208   SUBROUTINE exa_mpl( kt, pvar1, pvar2, ptab )              ! Empty routine
209      REAL::   ptab(:,:)
210      WRITE(*,*) 'exa_mpl: You should not have seen this print! error?', kt, pvar1, pvar2, ptab(1,1)
211   END SUBROUTINE exa_mpl
212#endif
213
214   !!======================================================================
215END MODULE exampl
Note: See TracBrowser for help on using the repository browser.