Changeset 921 for trunk/NEMO/LIM_SRC_3/limwri_dimg.h90
- Timestamp:
- 2008-05-13T10:28:52+02:00 (16 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/LIM_SRC_3/limwri_dimg.h90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/LIM_SRC_3/limwri_dimg.h90
r888 r921 1 1 SUBROUTINE lim_wri 2 2 !!---------------------------------------------------------------------- 3 3 !! LIM 2.0, UCL-LOCEAN-IPSL (2005) … … 5 5 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 6 6 !!---------------------------------------------------------------------- 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 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 34 #if ! defined key_diainstant 35 35 LOGICAL, PARAMETER :: ll_dia_inst=.false. ! local logical variable 36 36 #else 37 37 LOGICAL, PARAMETER :: ll_dia_inst=.true. 38 38 #endif 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 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 89 90 90 #if ! defined key_diainstant 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 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 , 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) = utaui_ice(ji,jj) 122 zcmo(ji,jj,16) = vtaui_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 134 #else 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 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 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) = utaui_ice(ji,jj) 165 rcmoy(ji,jj,16) = vtaui_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 171 #endif 172 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 clmode='instantaneous'188 189 WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average'190 191 192 193 194 195 196 197 9000 198 199 200 201 202 203 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) 197 9000 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 TracChangeset
for help on using the changeset viewer.
