Changeset 3564 for trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90
- Timestamp:
- 2012-11-15T18:42:30+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90
r3558 r3564 14 14 !! modif : 03/06/98 15 15 !!------------------------------------------------------------------- 16 USE diadimg ! use of dia_wri_dimg 17 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 16 USE diadimg ! use of dia_wri_dimg 18 17 19 18 INTEGER, INTENT(in) :: kt ! number of iteration … … 21 20 INTEGER , SAVE :: nmoyice !: counter for averaging 22 21 INTEGER , SAVE :: nwf !: number of fields to write on disk 23 INTEGER , SAVE, DIMENSION(:), ALLOCATABLE :: nsubindex !: subindex to be saved22 INTEGER, SAVE,DIMENSION (:), ALLOCATABLE :: nsubindex !: subindex to be saved 24 23 INTEGER , SAVE :: nice, nhorid, ndim, niter, ndepid 25 24 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE :: rcmoy … … 31 30 REAL(wp), DIMENSION(1) :: zdept 32 31 REAL(wp) :: zsto, zsec, zjulian,zout 33 REAL(wp) :: zindh,zinda,zindb, ztmu 34 REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: zcmo !ARPDBGWORK 35 REAL(wp), DIMENSION(jpi,jpj) :: zfield 32 REAL(wp) :: zindh, zinda, zindb, ztmu 33 REAL(wp), POINTER, DIMENSION(:,:) :: zfield 36 34 37 35 #if ! defined key_diainstant … … 46 44 IF( lk_mpp ) CALL mpp_sum ( ialloc ) 47 45 IF( ialloc /= 0 ) CALL ctl_warn('lim_wri_2 (limwri_dimg_2.h90) : failed to allocate arrays') 48 rcmoy(:,:,:) = 0._wp49 46 ENDIF 50 47 51 IF( kt == nit000 ) THEN 48 CALL wrk_alloc( jpi, jpj, zfield ) 49 50 IF ( kt == nit000 ) THEN 52 51 ! 53 52 CALL lim_wri_init_2 … … 56 55 ii = 0 57 56 58 IF (lwp ) THEN57 IF (lwp ) THEN 59 58 WRITE(numout,*) 'lim_wri_2 : Write ice outputs in dimg' 60 59 WRITE(numout,*) '~~~~~~~~' … … 80 79 END DO 81 80 81 rcmoy(:,:,:) = 0.0_wp 82 82 zsto = rdt_ice 83 83 zout = nwrite * rdt_ice / nn_fsbc … … 90 90 91 91 #if ! defined key_diainstant 92 !-- calculs des valeurs instantanees92 !-- Compute mean values 93 93 94 94 zcmo(:,:, 1:jpnoumax ) = 0.e0 95 95 DO jj = 2 , jpjm1 96 DO ji = 2 , jpim1 ! NO vector opt.96 DO ji = 2 , jpim1 97 97 zindh = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 98 98 zinda = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 99 99 zindb = zindh * zinda 100 ztmu = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )101 100 zcmo(ji,jj,1) = hsnif (ji,jj) 102 101 zcmo(ji,jj,2) = hicif (ji,jj) … … 105 104 zcmo(ji,jj,5) = sist (ji,jj) 106 105 zcmo(ji,jj,6) = fbif (ji,jj) 107 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 ) & 108 109 & + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 109 110 / ztmu 110 111 111 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 ) & 112 113 & + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 113 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 114 120 zcmo(ji,jj,9) = sst_m(ji,jj) 115 121 zcmo(ji,jj,10) = sss_m(ji,jj) … … 137 143 ! case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0 138 144 DO jj = 2 , jpjm1 139 DO ji = 2 , jpim1 ! NO vector opt.145 DO ji = 2 , jpim1 140 146 zindh = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 141 147 zinda = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 142 148 zindb = zindh * zinda 143 ztmu = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )144 149 rcmoy(ji,jj,1) = hsnif (ji,jj) 145 150 rcmoy(ji,jj,2) = hicif (ji,jj) … … 148 153 rcmoy(ji,jj,5) = sist (ji,jj) 149 154 rcmoy(ji,jj,6) = fbif (ji,jj) 150 rcmoy(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & 151 & + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 152 / ztmu 153 154 rcmoy(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj ) & 155 & + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 156 / 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 157 168 rcmoy(ji,jj,9) = sst_m(ji,jj) 158 169 rcmoy(ji,jj,10) = sss_m(ji,jj) … … 177 188 zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1) 178 189 179 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) 180 192 CALL lbc_lnk( zfield, 'T', -1. ) 181 ELSE193 CASE DEFAULT ! scalar fields 182 194 CALL lbc_lnk( zfield, 'T', 1. ) 183 END IF195 END SELECT 184 196 rcmoy(:,:,jf) = zfield(:,:) 185 197 END DO … … 201 213 nmoyice = 0 202 214 END IF ! MOD(kt+nn_fsbc-1-nit000+1, nwrite == 0 ) ! 215 CALL wrk_dealloc( jpi,jpj, zfield ) 203 216 204 217 END SUBROUTINE lim_wri_2
Note: See TracChangeset
for help on using the changeset viewer.