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 branches/nemo_v3_3_beta/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90 @ 2287

Last change on this file since 2287 was 2287, checked in by smasson, 14 years ago

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