Changeset 3564
- Timestamp:
- 2012-11-15T18:42:30+01:00 (12 years ago)
- Location:
- trunk/NEMOGCM/NEMO/LIM_SRC_2
- Files:
-
- 3 edited
-
dom_ice_2.F90 (modified) (1 diff)
-
limwri_2.F90 (modified) (6 diffs)
-
limwri_dimg_2.h90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90
r2715 r3564 32 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tms , tmu !: temperature and velocity points masks 33 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wght !: weight of the 4 neighbours to compute averages 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmv !: y-velocity mask used for evp rheology 34 35 35 36 # if defined key_lim2_vp37 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: akappa , bkappa !: first and third group of metric coefficients 38 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:,:) :: alambd !: second group of metric coefficients 39 # else 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmv , tmf !: y-velocity and F-points masks 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmf !: F-points masks 41 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmi !: ice mask: =1 if ice thick > 0 42 # endif43 40 !!---------------------------------------------------------------------- 44 41 CONTAINS -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90
r3558 r3564 31 31 USE lib_mpp ! MPP library 32 32 USE wrk_nemo ! work arrays 33 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)34 33 USE iom 35 34 USE ioipsl … … 105 104 !! 106 105 INTEGER :: ji, jj, jf ! dummy loop indices 107 CHARACTER(len = 40) :: clhstnam, clop106 CHARACTER(len = 80) :: clhstnam, clop 108 107 REAL(wp) :: zsto, zjulian, zout, & ! temporary scalars 109 108 & zindh, zinda, zindb, ztmu … … 161 160 zcmo(ji,jj,5) = sist (ji,jj) 162 161 zcmo(ji,jj,6) = fbif (ji,jj) 162 IF (lk_lim2_vp) THEN 163 163 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & 164 164 + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & … … 168 168 + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 169 169 / ztmu 170 ELSE 171 172 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj) & 173 & + u_ice(ji-1,jj) * tmu(ji-1,jj) ) & 174 & / 2.0 175 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmv(ji,jj) & 176 & + v_ice(ji,jj-1) * tmv(ji,jj-1) ) & 177 & / 2.0 178 179 ENDIF 170 180 zcmo(ji,jj,9) = sst_m(ji,jj) 171 181 zcmo(ji,jj,10) = sss_m(ji,jj) … … 187 197 niter = niter + 1 188 198 DO jf = 1 , noumef 189 DO jj = 1 , jpj 190 DO ji = 1 , jpi 191 zfield(ji,jj) = zcmo(ji,jj,jf) * cmulti(jf) + cadd(jf) 192 END DO 193 END DO 194 195 IF( jf == 7 .OR. jf == 8 .OR. jf == 15 .OR. jf == 16 ) THEN 199 zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) * tmask(:,:,1) 200 SELECT CASE ( jf ) 201 CASE ( 7, 8, 15, 16, 20, 21 ) ! velocity or stress fields (vectors) 196 202 CALL lbc_lnk( zfield, 'T', -1. ) 197 ELSE203 CASE DEFAULT ! scalar fields 198 204 CALL lbc_lnk( zfield, 'T', 1. ) 199 END IF200 205 END SELECT 206 201 207 IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 202 208 203 209 END DO 204 210 205 211 IF( ( nn_fsbc * niter ) >= nitend ) CALL histclo( nice ) 206 212 … … 209 215 END SUBROUTINE lim_wri_2 210 216 211 # endif217 #endif 212 218 213 219 SUBROUTINE lim_wri_init_2 -
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.
