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.
limdia_2.F90 in trunk/NEMOGCM/NEMO/LIM_SRC_2 – NEMO

source: trunk/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90 @ 6140

Last change on this file since 6140 was 4624, checked in by acc, 10 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.

  • Property svn:keywords set to Id
File size: 13.4 KB
Line 
1MODULE limdia_2
2   !!======================================================================
3   !!                       ***  MODULE limdia_2   ***
4   !!                      diagnostics of ice model
5   !!======================================================================
6   !! History :   8.0  !  97-06  (Louvain-La-Neuve)  Original code
7   !!             8.5  !  02-09  (C. Ethe , G. Madec )  F90: Free form and module
8   !!             9.0  !  06-08  (S. Masson)  change frequency output control
9   !!-------------------------------------------------------------------
10#if defined key_lim2
11   !!----------------------------------------------------------------------
12   !!   'key_lim2' :                                  LIM 2.0 sea-ice model
13   !!----------------------------------------------------------------------
14   !!   lim_dia_2      : computation of the time evolution of keys var.
15   !!   lim_dia_init_2 : initialization and namelist read
16   !!----------------------------------------------------------------------
17   USE dom_oce         ! ocean space and time domain
18   USE phycst          !
19   USE par_ice_2       ! ice parameters
20   USE sbc_oce         ! surface boundary condition variables
21   USE dom_ice_2       !
22   USE ice_2           !
23   USE limistate_2     !
24   USE in_out_manager  ! I/O manager
25   USE lib_mpp         ! MPP library
26   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC               lim_dia_2          ! called by sbc_ice_lim_2
32   PUBLIC               lim_dia_init_2     ! called by sbc_ice_lim_2
33
34   INTEGER, PUBLIC ::   ntmoy  ,   &  !: instantaneous values of ice evolution or averaging ntmoy
35      &                 ninfo         !: frequency of ouputs on file ice_evolu in case of averaging
36
37   INTEGER, PARAMETER ::   &  ! Parameters for outputs to files "evolu"
38      jpinfmx = 100         ,    &  ! maximum number of key variables
39      jpchinf = 5           ,    &  ! ???
40      jpchsep = jpchinf + 2         ! ???
41
42   INTEGER ::   &
43      nfrinf ,          &  ! number of variables written in one line
44      nferme ,          &  ! last time step at which the var. are written on file
45      nvinfo ,          &  ! number of total variables
46      nbvt   ,          &  ! number of time variables
47      naveg                ! number of step for accumulation before averaging
48
49   CHARACTER(len= 8) ::   fmtinf   ! format of the output values 
50   CHARACTER(len=30) ::   fmtw  ,           &  ! formats
51      &                   fmtr  ,           &  ! ???
52      &                   fmtitr               ! ???
53   CHARACTER(len=jpchsep), DIMENSION(jpinfmx) ::   titvar               ! title of key variables
54 
55   REAL(wp)                     ::   epsi06 = 1.e-06      ! ???
56   REAL(wp), DIMENSION(jpinfmx) ::   vinfom               ! temporary working space
57   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   aire                 ! masked grid cell area
58
59   !! * Substitutions
60#  include "vectopt_loop_substitute.h90"
61   !!----------------------------------------------------------------------
62   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
63   !! $Id$
64   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
65   !!----------------------------------------------------------------------
66CONTAINS
67
68   SUBROUTINE lim_dia_2( kt )
69      !!--------------------------------------------------------------------
70      !!                  ***  ROUTINE lim_dia_2  ***
71      !!   
72      !! ** Purpose : Computation and outputs on file ice.evolu
73      !!      the temporal evolution of some key variables
74      !!-------------------------------------------------------------------
75      INTEGER, INTENT(in) ::   kt     ! number of iteration
76      !!
77      INTEGER  ::   jv,ji, jj   ! dummy loop indices
78      INTEGER  ::   nv          ! indice of variable
79      REAL(wp) ::   zarea    , zldarea  ,    &  ! sea-ice and leads area
80         &          zextent15, zextent85,    &  ! sea-ice extent (15% and 85%)
81         &          zicevol  , zsnwvol  ,    &  ! sea-ice and snow volume volume
82         &          zicespd                     ! sea-ice velocity
83      REAL(wp), DIMENSION(jpinfmx) ::   vinfor  ! temporary working space
84      !!-------------------------------------------------------------------
85
86      ! computation of key variables at each time step   
87
88      nv = 1 
89      vinfor(nv) = REAL( kt + nn_fsbc - 1 )
90      nv = nv + 1
91      vinfor(nv) = nyear
92 
93      DO jv = nbvt + 1, nvinfo
94         vinfor(jv) = 0.e0
95      END DO
96
97      zextent15 = 0.e0
98      zextent85 = 0.e0
99      ! variables in northern Hemis
100      DO jj = njeq, jpjm1
101         DO ji = fs_2, fs_jpim1   ! vector opt.
102            IF( tms(ji,jj) == 1 ) THEN
103               zarea = ( 1.0 - frld(ji,jj) ) * aire(ji,jj)
104               IF (frld(ji,jj) <= 0.15 ) zextent15 = aire(ji,jj)   
105               IF (frld(ji,jj) <= 0.85 ) zextent85 = aire(ji,jj)   
106               zldarea = zarea   / MAX( ( 1 - frld(ji,jj) ) , epsi06 )
107               zicevol = zarea   * hicif(ji,jj)
108               zsnwvol = zarea   * hsnif(ji,jj)
109               zicespd = zicevol * ( u_ice(ji,jj) * u_ice(ji,jj) + v_ice(ji,jj) * v_ice(ji,jj) )
110               vinfor(nv+ 1) = vinfor(nv+ 1) + zarea
111               vinfor(nv+ 3) = vinfor(nv+ 3) + zextent15
112               vinfor(nv+ 5) = vinfor(nv+ 5) + zextent85
113               vinfor(nv+ 7) = vinfor(nv+ 7) + zldarea
114               vinfor(nv+ 9) = vinfor(nv+ 9) + zicevol
115               vinfor(nv+11) = vinfor(nv+11) + zsnwvol
116               vinfor(nv+13) = vinfor(nv+13) + zicespd
117            ENDIF
118         END DO
119      END DO
120      vinfor(nv+13) = SQRT( vinfor(nv+13) / MAX( vinfor(nv+9) , epsi06 ) )
121
122
123      ! variables in southern Hemis
124       nv = nv + 1
125       DO jj = 2, njeqm1
126          DO ji = fs_2, fs_jpim1   ! vector opt.
127             IF( tms(ji,jj) == 1 ) THEN
128                zarea = ( 1.0 - frld(ji,jj) ) * aire(ji,jj)
129                IF (frld(ji,jj) <= 0.15 ) zextent15 = aire(ji,jj)   
130                IF (frld(ji,jj) <= 0.85 ) zextent85 = aire(ji,jj)   
131                zldarea = zarea   / MAX( ( 1 - frld(ji,jj) ) , epsi06 )
132                zicevol = zarea   * hicif(ji,jj)
133                zsnwvol = zarea   * hsnif(ji,jj)
134                zicespd = zicevol * ( u_ice(ji,jj) * u_ice(ji,jj) + v_ice(ji,jj) * v_ice(ji,jj) )
135                vinfor(nv+ 1) = vinfor(nv+ 1) + zarea
136                vinfor(nv+ 3) = vinfor(nv+ 3) + zextent15
137                vinfor(nv+ 5) = vinfor(nv+ 5) + zextent85
138                vinfor(nv+ 7) = vinfor(nv+ 7) + zldarea
139                vinfor(nv+ 9) = vinfor(nv+ 9) + zicevol
140                vinfor(nv+11) = vinfor(nv+11) + zsnwvol
141                vinfor(nv+13) = vinfor(nv+13) + zicespd
142             ENDIF
143          END DO
144       END DO
145       vinfor(nv+13) = SQRT( vinfor(nv+13) / MAX( vinfor(nv+9) , epsi06 ) )   
146
147       !  Accumulation before averaging
148       DO jv = 1, nvinfo
149          vinfom(jv) = vinfom(jv) + vinfor(jv)
150       END DO
151       naveg = naveg + 1 
152   
153       ! oututs on file ice_evolu   
154       IF( MOD( kt + nn_fsbc - 1, ninfo ) == 0 ) THEN
155          WRITE(numevo_ice,fmtw) ( titvar(jv), vinfom(jv)/naveg, jv = 1, nvinfo )
156          naveg = 0
157          DO jv = 1, nvinfo
158             vinfom(jv) = 0.e0
159          END DO
160       ENDIF
161       !
162    END SUBROUTINE lim_dia_2
163 
164
165    SUBROUTINE lim_dia_init_2
166       !!-------------------------------------------------------------------
167       !!                  ***  ROUTINE lim_dia_init_2  ***
168       !!             
169       !! ** Purpose : Preparation of the file ice_evolu for the output of
170       !!      the temporal evolution of key variables
171       !!
172       !! ** input   : Namelist namicedia
173       !!-------------------------------------------------------------------
174       CHARACTER(len=jpchinf) ::   titinf
175       INTEGER  ::   jv   ! dummy loop indice
176       INTEGER  ::   ntot , ndeb, nv, ierr   ! local integer
177       INTEGER  ::   ios                     ! Local integer output status for namelist read
178       REAL(wp) ::   zxx0, zxx1              ! local scalars
179
180       NAMELIST/namicedia/fmtinf, nfrinf, ninfo, ntmoy
181       !!-------------------------------------------------------------------
182                   
183       REWIND( numnam_ice_ref )              ! Namelist namicedia in reference namelist : Ice diagnostics in ice_evolu
184       READ  ( numnam_ice_ref, namicedia, IOSTAT = ios, ERR = 901)
185901    IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicedia in reference namelist', lwp )
186
187       REWIND( numnam_ice_cfg )              ! Namelist namicedia in configuration namelist : Ice diagnostics in ice_evolu
188       READ  ( numnam_ice_cfg, namicedia, IOSTAT = ios, ERR = 902 )
189902    IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicedia in configuration namelist', lwp )
190       IF(lwm) WRITE ( numoni, namicedia )
191       
192       IF(lwp) THEN                             ! control print
193          WRITE(numout,*)
194          WRITE(numout,*) 'lim_dia_init_2 : ice parameters for ice diagnostics '
195          WRITE(numout,*) '~~~~~~~~~~~~~~'
196          WRITE(numout,*) '   format of the output values                                 fmtinf = ', fmtinf
197          WRITE(numout,*) '   number of variables written in one line                     nfrinf = ', nfrinf 
198          WRITE(numout,*) '   Instantaneous values of ice evolution or averaging          ntmoy  = ', ntmoy
199          WRITE(numout,*) '   frequency of ouputs on file ice_evolu in case of averaging  ninfo  = ', ninfo
200       ENDIF
201
202       ALLOCATE( aire(jpi,jpj) , STAT=ierr )    ! masked grid cell area
203       IF( lk_mpp    )   CALL mpp_sum( ierr )
204       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'lim_dia_init_2 : unable to allocate standard arrays' )
205       aire(:,:) = area(:,:) * tms(:,:)
206
207       nv = 1                                   ! Titles of ice key variables
208       titvar(nv) = 'NoIt'  ! iteration number
209       nv = nv + 1
210       titvar(nv) = 'T yr'  ! time step in years
211       nbvt = nv - 1
212       nv = nv + 1   ;   titvar(nv) = 'AEFN' ! sea ice area in the northern Hemisp.(10^12 km2)
213       nv = nv + 1   ;   titvar(nv) = 'AEFS' ! sea ice area in the southern Hemisp.(10^12 km2)
214       nv = nv + 1   ;   titvar(nv) = 'A15N'  ! sea ice extent (15%) in the northern Hemisp.(10^12 km2)
215       nv = nv + 1   ;   titvar(nv) = 'A15S'  ! sea ice extent (15%) in the southern Hemisp.(10^12 km2)
216       nv = nv + 1   ;   titvar(nv) = 'A85N'  ! sea ice extent (85%) in the northern Hemisp.(10^12 km2)
217       nv = nv + 1   ;   titvar(nv) = 'A85S'  ! sea ice extent (85%) in the southern Hemisp.(10^12 km2)
218       nv = nv + 1   ;   titvar(nv) = 'ALEN'  ! leads area in the northern Hemisp.(10^12 km2)
219       nv = nv + 1   ;   titvar(nv) = 'ALES'  ! leads area in the southern Hemisp.(10^12 km2)
220       nv = nv + 1   ;   titvar(nv) = 'VOLN'  ! sea ice volume in the northern Hemisp.(10^3 km3)
221       nv = nv + 1   ;   titvar(nv) = 'VOLS'  ! sea ice volume in the southern Hemisp.(10^3 km3)
222       nv = nv + 1   ;   titvar(nv) = 'VONN'  ! snow volume over sea ice in the northern Hemisp.(10^3 km3)
223       nv = nv + 1   ;   titvar(nv) = 'VONS'  ! snow volume over sea ice in the southern Hemisp.(10^3 km3)
224       nv = nv + 1   ;   titvar(nv) = 'ECGN'  ! mean sea ice velocity in the northern Hemisp.(m/s)
225       nv = nv + 1   ;   titvar(nv) = 'ECGS'  ! mean sea ice velocity in the southern Hemisp.(m/s)
226
227       nvinfo = nv
228
229       ! Definition et Ecriture de l'entete : nombre d'enregistrements
230       ndeb   = ( nit000 - 1 + nn_fsbc - 1 ) / ninfo
231       IF( nit000 - 1 + nn_fsbc == 1 ) ndeb = -1
232
233       nferme = ( nitend + nn_fsbc - 1 ) / ninfo ! nit000 - 1 + nn_fsbc - 1 + nitend - nit000 + 1
234       ntot   = nferme - ndeb
235       ndeb   = ninfo * ( 1 + ndeb )
236       nferme = ninfo * nferme
237
238       ! definition of formats
239       WRITE( fmtw  , '(A,I3,A2,I1,A)' )  '(', nfrinf, '(A', jpchsep, ','//fmtinf//'))'
240       WRITE( fmtr  , '(A,I3,A,I1,A)'  )  '(', nfrinf, '(', jpchsep, 'X,'//fmtinf//'))'
241       WRITE( fmtitr, '(A,I3,A,I1,A)'  )  '(', nvinfo, 'A', jpchinf, ')'
242
243       ! opening  "ice_evolu" file
244       CALL ctl_opn( numevo_ice, 'ice_evolu', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
245
246       !- ecriture de 2 lignes d''entete :
247       WRITE(numevo_ice,1000) fmtr, fmtw, fmtitr, nvinfo, ntot, 0, nfrinf
248       zxx0 = 0.001 * REAL( ninfo )
249       zxx1 = 0.001 * REAL( ndeb  )
250       WRITE(numevo_ice,1111) REAL(jpchinf), 0., zxx1, zxx0, 0., 0., 0
251
252       !- ecriture de 2 lignes de titre :
253       WRITE(numevo_ice,'(A,I8,A,I8,A,I5)')                 &
254          'Evolution chronologique - Experience '//cexper   &
255          //'   de', ndeb, ' a', nferme, ' pas', ninfo
256       WRITE(numevo_ice,fmtitr) ( titvar(jv), jv = 1, nvinfo )
257
258
259       !--preparation de "titvar" pour l''ecriture parmi les valeurs numeriques :
260       DO  jv = 2 , nvinfo
261          titinf     = titvar(jv)(:jpchinf)
262          titvar(jv) = '  '//titinf
263       END DO
264
265       !--Initialisation of the arrays for the accumulation
266       DO  jv = 1, nvinfo
267          vinfom(jv) = 0.
268       END DO
269       naveg = 0
270
2711000   FORMAT( 3(A20),4(1x,I6) )
2721111   FORMAT( 3(F7.1,1X,F7.3,1X),I3,A ) 
273      !
274    END SUBROUTINE lim_dia_init_2
275
276#else
277   !!----------------------------------------------------------------------
278   !!   Default option :                           NO LIM 2.0 sea-ice model
279   !!----------------------------------------------------------------------
280CONTAINS
281   SUBROUTINE lim_dia_2         ! Empty routine
282   END SUBROUTINE lim_dia_2
283#endif
284
285   !!======================================================================
286END MODULE limdia_2
Note: See TracBrowser for help on using the repository browser.