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.
limwri_dimg.h90 in trunk/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90 @ 2715

Last change on this file since 2715 was 2715, checked in by rblod, 13 years ago

First attempt to put dynamic allocation on the trunk

  • Property svn:keywords set to Id
File size: 7.5 KB
Line 
1SUBROUTINE lim_wri
2   !!----------------------------------------------------------------------
3   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
4   !! $Id$
5   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
6   !!----------------------------------------------------------------------
7   !!-------------------------------------------------------------------
8   !!  This routine computes the average of some variables and write it
9   !!  on the ouput files.
10   !!  ATTENTION cette routine n'est valable que si le pas de temps est
11   !!  egale a une fraction entiere de 1 jours.
12   !!  Diff 1-D 3-D : suppress common also included in etat
13   !!                 suppress cmoymo 11-18
14   !!  modif : 03/06/98
15   !!-------------------------------------------------------------------
16   USE  diawri, ONLY : dia_wri_dimg
17   REAL(wp),DIMENSION(1) ::   zdept
18
19   REAL(wp) ::   zsto, zsec, zjulian,zout, &
20   REAL(wp) ::   zindh,zinda,zindb, ztmu
21   REAL(wp), DIMENSION(jpi,jpj,jpnoumax) ::   zcmo
22   REAL(wp), DIMENSION(jpi,jpj) ::   zfield
23   INTEGER, SAVE ::   nmoyice   !: counter for averaging
24   INTEGER, SAVE ::   nwf       !: number of fields to write on disk
25   INTEGER, SAVE,DIMENSION (:), ALLOCATABLE  :: nsubindex   !: subindex to be saved
26   ! according to namelist
27
28   REAL(wp), SAVE, DIMENSION(jpi,jpj,jpnoumax) :: rcmoy
29#if ! defined key_diainstant
30   LOGICAL, PARAMETER :: ll_dia_inst=.false.      ! local logical variable
31#else
32   LOGICAL, PARAMETER :: ll_dia_inst=.true.
33#endif
34   INTEGER ::  ji, jj, jf, ii   ! dummy loop indices and array index
35   INTEGER :: iyear, iday, imon !
36
37   CHARACTER(LEN=80) :: clname, cltext, clmode
38
39
40   INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid
41   INTEGER , DIMENSION( jpij ) , SAVE ::   ndex51 
42   !!-------------------------------------------------------------------
43   IF ( numit == nstart ) THEN
44
45      CALL lim_wri_init
46
47      nwf = 0
48      ii  = 0
49
50      IF (lwp ) THEN
51         WRITE(numout,*) 'lim_wri : Write ice outputs in dimg'
52         WRITE(numout,*) '~~~~~~~~'
53         WRITE(numout,*) '   According to namelist_ice, following fields saved:'
54         DO jf =1, noumef
55            IF (nc(jf) == 1 ) THEN
56               WRITE(numout,* ) '    -',titn(jf), nam(jf), uni(jf)
57            ENDIF
58         END DO
59      ENDIF
60
61      DO jf = 1, noumef
62         IF (nc(jf) == 1 ) nwf = nwf + 1
63      END DO
64
65      ALLOCATE( nsubindex (nwf) )
66
67      DO jf = 1, noumef
68         IF (nc(jf) == 1 ) THEN
69            ii = ii +1
70            nsubindex(ii) = jf
71         END IF
72      END DO
73
74      zsto     = rdt_ice
75      zout     = nwrite * rdt_ice / nn_fsbc
76      zsec     = 0.
77      niter    = 0
78      zdept(1) = 0.
79      nmoyice  = 0
80
81   ENDIF
82
83#if ! defined key_diainstant
84   !-- calculs des valeurs instantanees
85
86   zcmo(:,:, 1:jpnoumax ) = 0.e0
87   DO jj = 2 , jpjm1
88      DO ji = 2 , jpim1   ! NO vector opt.
89         zindh  = MAX( zzero , SIGN( zone , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) )
90         zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
91         zindb  = zindh * zinda
92         ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )
93         zcmo(ji,jj,1)  = ht_s (ji,jj,1)
94         zcmo(ji,jj,2)  = ht_i (ji,jj,1)
95         zcmo(ji,jj,3)  = hicifp(ji,jj)
96         zcmo(ji,jj,4)  = frld  (ji,jj)
97         zcmo(ji,jj,5)  = sist  (ji,jj)
98         zcmo(ji,jj,6)  = fbif  (ji,jj)
99         zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
100            + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
101            / ztmu
102
103         zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
104            + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
105            / ztmu
106         zcmo(ji,jj,9)  = sst_m(ji,jj)
107         zcmo(ji,jj,10) = sss_m(ji,jj)
108
109         zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
110         zcmo(ji,jj,12) = qsr(ji,jj)
111         zcmo(ji,jj,13) = qns(ji,jj)
112         ! See thersf for the coefficient
113         zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
114         zcmo(ji,jj,15) = utau_ice(ji,jj)
115         zcmo(ji,jj,16) = vtau_ice(ji,jj)
116         zcmo(ji,jj,17) = qsr (ji,jj)
117         zcmo(ji,jj,18) = qns(ji,jj)
118         zcmo(ji,jj,19) = sprecip(ji,jj)
119      END DO
120   END DO
121   ! Cumulates values between outputs           
122   rcmoy(:,:,:)= rcmoy(:,:,:) + zcmo(:,:,:)
123   nmoyice = nmoyice + 1
124   ! compute mean value if it is time to write on file
125   IF ( MOD(numit,nwrite) == 0 ) THEN
126      rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice)
127#else 
128      IF ( MOD(numit,nwrite) == 0 ) THEN
129         !  case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0
130         DO jj = 2 , jpjm1
131            DO ji = 2 , jpim1   ! NO vector opt.
132               zindh  = MAX( zzero , SIGN( zone , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) )
133               zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
134               zindb  = zindh * zinda
135               ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )
136               rcmoy(ji,jj,1)  = ht_s (ji,jj,1)
137               rcmoy(ji,jj,2)  = ht_i (ji,jj,1)
138               rcmoy(ji,jj,3)  = hicifp(ji,jj)
139               rcmoy(ji,jj,4)  = frld  (ji,jj)
140               rcmoy(ji,jj,5)  = sist  (ji,jj)
141               rcmoy(ji,jj,6)  = fbif  (ji,jj)
142               rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
143                  + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
144                  / ztmu
145
146               rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
147                  + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
148                  / ztmu
149               rcmoy(ji,jj,9)  = sst_m(ji,jj)
150               rcmoy(ji,jj,10) = sss_m(ji,jj)
151
152               rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
153               rcmoy(ji,jj,12) = qsr(ji,jj)
154               rcmoy(ji,jj,13) = qns(ji,jj)
155               ! See thersf for the coefficient
156               rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
157               rcmoy(ji,jj,15) = utau_ice(ji,jj)
158               rcmoy(ji,jj,16) = vtau_ice(ji,jj)
159               rcmoy(ji,jj,17) = qsr(ji,jj)
160               rcmoy(ji,jj,18) = qns(ji,jj)
161               rcmoy(ji,jj,19) = sprecip(ji,jj)
162            END DO
163         END DO
164#endif
165
166         !
167         niter = niter + 1
168         DO jf = 1 , noumef
169            zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1)
170
171            IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN
172               CALL lbc_lnk( zfield, 'T', -1. )
173            ELSE
174               CALL lbc_lnk( zfield, 'T',  1. )
175            ENDIF
176            rcmoy(:,:,jf) = zfield(:,:)
177         END DO
178
179         IF (ll_dia_inst) THEN
180            clmode='instantaneous'
181         ELSE
182            WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average'
183         END IF
184         iyear = ndastp/10000
185         imon = (ndastp-iyear*10000)/100
186         iday = ndastp - imon*100 - iyear*10000
187         WRITE(clname,9000) TRIM(cexper),'ICEMOD',iyear,imon,iday
188         cltext=TRIM(cexper)//' ice modele output'//TRIM(clmode)
189         CALL dia_wri_dimg (clname, cltext, rcmoy, nwf , 'I', nsubindex)
1909000     FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
191
192         rcmoy(:,:,:) = 0.0
193         nmoyice = 0
194      END IF     !  MOD(numit, nwrite == 0 ) !
195
196   END SUBROUTINE lim_wri
Note: See TracBrowser for help on using the repository browser.