- Timestamp:
- 2013-01-23T15:33:04+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90
r3625 r3764 20 20 INTEGER , SAVE :: nmoyice !: counter for averaging 21 21 INTEGER , SAVE :: nwf !: number of fields to write on disk 22 INTEGER , SAVE, DIMENSION(:), ALLOCATABLE :: nsubindex !: subindex to be saved22 INTEGER, SAVE,DIMENSION (:), ALLOCATABLE :: nsubindex !: subindex to be saved 23 23 INTEGER , SAVE :: nice, nhorid, ndim, niter, ndepid 24 24 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE :: rcmoy … … 30 30 REAL(wp), DIMENSION(1) :: zdept 31 31 REAL(wp) :: zsto, zsec, zjulian,zout 32 REAL(wp) :: zindh,zinda,zindb, ztmu 33 REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: zcmo !ARPDBGWORK 34 REAL(wp), DIMENSION(jpi,jpj) :: zfield 32 REAL(wp) :: zindh, zinda, zindb, ztmu 33 REAL(wp), POINTER, DIMENSION(:,:) :: zfield 35 34 36 35 #if ! defined key_diainstant … … 45 44 IF( lk_mpp ) CALL mpp_sum ( ialloc ) 46 45 IF( ialloc /= 0 ) CALL ctl_warn('lim_wri_2 (limwri_dimg_2.h90) : failed to allocate arrays') 47 rcmoy(:,:,:) = 0._wp48 46 ENDIF 49 47 50 IF( kt == nit000 ) THEN 48 CALL wrk_alloc( jpi, jpj, zfield ) 49 50 IF ( kt == nit000 ) THEN 51 51 ! 52 52 CALL lim_wri_init_2 … … 55 55 ii = 0 56 56 57 IF (lwp ) THEN57 IF (lwp ) THEN 58 58 WRITE(numout,*) 'lim_wri_2 : Write ice outputs in dimg' 59 59 WRITE(numout,*) '~~~~~~~~' … … 79 79 END DO 80 80 81 rcmoy(:,:,:) = 0.0_wp 81 82 zsto = rdt_ice 82 83 zout = nwrite * rdt_ice / nn_fsbc … … 89 90 90 91 #if ! defined key_diainstant 91 !-- calculs des valeurs instantanees92 !-- Compute mean values 92 93 93 94 zcmo(:,:, 1:jpnoumax ) = 0.e0 94 95 DO jj = 2 , jpjm1 95 DO ji = 2 , jpim1 ! NO vector opt.96 DO ji = 2 , jpim1 96 97 zindh = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 97 98 zinda = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 98 99 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 100 zcmo(ji,jj,1) = hsnif (ji,jj) 101 101 zcmo(ji,jj,2) = hicif (ji,jj) … … 104 104 zcmo(ji,jj,5) = sist (ji,jj) 105 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 ) & 106 IF (lk_lim2_vp) THEN 107 ztmu = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 108 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & 107 109 & + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 108 110 / ztmu 109 111 110 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj ) &112 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj ) & 111 113 & + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 112 114 / ztmu 115 ELSE 116 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) )/ 2.0 117 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) )/ 2.0 118 ENDIF 119 113 120 zcmo(ji,jj,9) = sst_m(ji,jj) 114 121 zcmo(ji,jj,10) = sss_m(ji,jj) … … 136 143 ! case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0 137 144 DO jj = 2 , jpjm1 138 DO ji = 2 , jpim1 ! NO vector opt.145 DO ji = 2 , jpim1 139 146 zindh = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 140 147 zinda = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 141 148 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 149 rcmoy(ji,jj,1) = hsnif (ji,jj) 144 150 rcmoy(ji,jj,2) = hicif (ji,jj) … … 147 153 rcmoy(ji,jj,5) = sist (ji,jj) 148 154 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 155 IF (lk_lim2_vp) THEN 156 ztmu = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 157 rcmoy(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & 158 & + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 159 / ztmu 160 161 rcmoy(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj ) & 162 & + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 163 / ztmu 164 ELSE 165 rcmoy(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) )/ 2.0 166 rcmoy(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) )/ 2.0 167 ENDIF 156 168 rcmoy(ji,jj,9) = sst_m(ji,jj) 157 169 rcmoy(ji,jj,10) = sss_m(ji,jj) … … 176 188 zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1) 177 189 178 IF ( jf == 7 .OR. jf == 8 .OR. jf == 15 .OR. jf == 16 ) THEN 190 SELECT CASE (jf) 191 CASE ( 7, 8, 15, 16 ) ! velocity or stress fields (vectors) 179 192 CALL lbc_lnk( zfield, 'T', -1. ) 180 ELSE193 CASE DEFAULT ! scalar fields 181 194 CALL lbc_lnk( zfield, 'T', 1. ) 182 END IF195 END SELECT 183 196 rcmoy(:,:,jf) = zfield(:,:) 184 197 END DO … … 200 213 nmoyice = 0 201 214 END IF ! MOD(kt+nn_fsbc-1-nit000+1, nwrite == 0 ) ! 215 CALL wrk_dealloc( jpi,jpj, zfield ) 202 216 203 217 END SUBROUTINE lim_wri_2
Note: See TracChangeset
for help on using the changeset viewer.
