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

Last change on this file since 508 was 508, checked in by opalod, 15 years ago

nemo_v1_update_071:RB: add iom for restart and reorganization of restart

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