source: trunk/NEMO/LIM_SRC/limwri_dimg.h90 @ 284

Last change on this file since 284 was 284, checked in by opalod, 16 years ago

nemo_v1_bugfix_001 : CT : to ensure the coherence between ocean & sea-ice fields if making a restart in using DIMG format

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.1 KB
Line 
1    SUBROUTINE lim_wri
2   !!----------------------------------------------------------------------
3   !!  LIM 2.0, UCL-LOCEAN-IPSL (2005)
4   !! $Header$
5   !! This software is governed by the CeCILL licence see modipsl/doc/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  diadimg                ! use of 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 / nfice
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
96          zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (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)  = hsnif (ji,jj)
101          zcmo(ji,jj,2)  = hicif (ji,jj)
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_io(ji,jj)
114          zcmo(ji,jj,10) = sss_io(ji,jj)
115
116          zcmo(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj)
117          zcmo(ji,jj,12) = fsolar (ji,jj)
118          zcmo(ji,jj,13) = fnsolar(ji,jj)
119          ! See thersf for the coefficient
120          zcmo(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce
121          zcmo(ji,jj,15) = gtaux(ji,jj)
122          zcmo(ji,jj,16) = gtauy(ji,jj)
123          zcmo(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce (ji,jj)
124          zcmo(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(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-nit000+1,nwrite) == 0 ) THEN
133       rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice)
134#else 
135       IF ( MOD(numit-nit000+1,nwrite) == 0 ) THEN
136          !  case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0
137          DO jj = 2 , jpjm1
138             DO ji = 2 , jpim1
139                zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (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)  = hsnif (ji,jj)
144                rcmoy(ji,jj,2)  = hicif (ji,jj)
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_io(ji,jj)
157                rcmoy(ji,jj,10) = sss_io(ji,jj)
158
159                rcmoy(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj)
160                rcmoy(ji,jj,12) = fsolar (ji,jj)
161                rcmoy(ji,jj,13) = fnsolar(ji,jj)
162                ! See thersf for the coefficient
163                rcmoy(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce
164                rcmoy(ji,jj,15) = gtaux(ji,jj)
165                rcmoy(ji,jj,16) = gtauy(ji,jj)
166                rcmoy(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce (ji,jj)
167                rcmoy(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(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 == 11 .OR. jf == 12 .OR. jf == 15 .OR.   &
179                  jf == 23 .OR. jf == 24 .OR. jf == 16 ) THEN
180                CALL lbc_lnk( zfield, 'T', -1. )
181             ELSE
182                CALL lbc_lnk( zfield, 'T',  1. )
183             ENDIF
184             rcmoy(:,:,jf) = zfield(:,:)
185          END DO
186
187          IF (ll_dia_inst) THEN
188           clmode='instantaneous'
189          ELSE
190           WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average'
191          END IF
192          iyear = ndastp/10000
193          imon = (ndastp-iyear*10000)/100
194          iday = ndastp - imon*100 - iyear*10000
195          WRITE(clname,9000) TRIM(cexper),'ICEMOD',iyear,imon,iday
196          cltext=TRIM(cexper)//' ice modele output'//TRIM(clmode)
197          CALL dia_wri_dimg (clname, cltext, rcmoy, nwf , 'I', nsubindex)
1989000      FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
199
200          rcmoy(:,:,:) = 0.0
201          nmoyice = 0
202       END IF     !  MOD(numit, nwrite == 0 ) !
203
204     END SUBROUTINE lim_wri
Note: See TracBrowser for help on using the repository browser.