- Timestamp:
- 2010-04-30T17:49:04+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1837_mass_heat_salt_fluxes/NEMO/LIM_SRC_2/limhdf_2.F90
r1465 r1855 4 4 !! LIM 2.0 ice model : horizontal diffusion of sea-ice quantities 5 5 !!====================================================================== 6 !! History : LIM ! 2000-01 (UCL) Original code 7 !! 1.0 ! 2001-05 (G. Madec, R. Hordoir) opa norm 8 !! 2.0 ! 2002-08 (C. Ethe) F90, free form 9 !!---------------------------------------------------------------------- 6 10 #if defined key_lim2 7 11 !!---------------------------------------------------------------------- … … 10 14 !! lim_hdf_2 : diffusion trend on sea-ice variable 11 15 !!---------------------------------------------------------------------- 12 !! * Modules used 13 USE dom_oce 14 USE in_out_manager 15 USE ice_2 16 USE lbclnk 17 USE lib_mpp 18 USE prtctl ! Print control 16 USE dom_oce ! ocean domain 17 USE ice_2 ! LIM-2 variables 18 USE prtctl ! Print control 19 USE lbclnk ! 20 USE lib_mpp ! 21 USE in_out_manager ! I/O manager 19 22 20 23 IMPLICIT NONE 21 24 PRIVATE 22 25 23 !! * Routine accessibility 24 PUBLIC lim_hdf_2 ! called by lim_tra_2 26 PUBLIC lim_hdf_2 ! called by lim_tra_2 25 27 26 !! * Module variables 27 LOGICAL :: linit = .TRUE. ! ??? 28 LOGICAL :: linit = .TRUE. ! indictor of initialisation 28 29 REAL(wp) :: epsi04 = 1e-04 ! constant 29 REAL(wp), DIMENSION(jpi,jpj) :: zfact ! ???30 REAL(wp), DIMENSION(jpi,jpj) :: zfact ! metric term 30 31 31 32 !! * Substitution 32 33 # include "vectopt_loop_substitute.h90" 33 34 !!---------------------------------------------------------------------- 34 !! LIM 2.0, UCL-LOCEAN-IPSL (2005)35 !! NEMO/LIM 3.3, UCL-LOCEAN-IPSL (2010) 35 36 !! $Id$ 36 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt37 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 37 38 !!---------------------------------------------------------------------- 38 39 … … 43 44 !! *** ROUTINE lim_hdf_2 *** 44 45 !! 45 !! ** purpose : Compute and add the diffusive trend on sea-ice 46 !! variables 46 !! ** purpose : Compute and add the diffusive trend on sea-ice variables 47 47 !! 48 48 !! ** method : Second order diffusive operator evaluated using a 49 !! Cranck-Nicholson time Scheme.49 !! Cranck-Nicholson time Scheme. 50 50 !! 51 !! ** Action : update ptab with the diffusive contribution 51 !! ** Action : update ptab with the diffusive contribution 52 !!------------------------------------------------------------------- 53 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: ptab ! Field on which the diffusion is applied 52 54 !! 53 !! History :54 !! ! 00-01 (LIM) Original code55 !! ! 01-05 (G. Madec, R. Hordoir) opa norm56 !! ! 02-08 (C. Ethe) F90, free form57 !!-------------------------------------------------------------------58 ! * Arguments59 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: &60 ptab ! Field on which the diffusion is applied61 REAL(wp), DIMENSION(jpi,jpj) :: &62 ptab0 ! ???63 64 ! * Local variables65 55 INTEGER :: ji, jj ! dummy loop indices 66 INTEGER :: & 67 its, iter ! temporary integers 56 INTEGER :: its, iter ! temporary integers 68 57 CHARACTER (len=55) :: charout 69 REAL(wp) :: & 70 zalfa, zrlxint, zconv, zeps ! temporary scalars 71 REAL(wp), DIMENSION(jpi,jpj) :: & 72 zrlx, zflu, zflv, & ! temporary workspaces 73 zdiv0, zdiv ! " " 58 REAL(wp) :: zalfa, zrlxint, zconv, zeps ! temporary scalars 59 REAL(wp), DIMENSION(jpi,jpj) :: zrlx, zflu, zflv, zdiv0, zdiv ! temporary workspaces 60 REAL(wp), DIMENSION(jpi,jpj) :: ztab0 ! ??? 74 61 !!------------------------------------------------------------------- 75 62 … … 82 69 83 70 ! Arrays initialization 84 ptab0 (:, : ) = ptab(:,:) 85 !bug zflu (:,jpj) = 0.e0 86 !bug zflv (:,jpj) = 0.e0 71 ztab0(:, : ) = ptab(:,:) 87 72 zdiv0(:, 1 ) = 0.e0 88 73 zdiv0(:,jpj) = 0.e0 … … 98 83 DO jj = 2, jpjm1 99 84 DO ji = fs_2 , fs_jpim1 ! vector opt. 100 zfact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj ) + e1v(ji,jj) + e1v(ji,jj-1) ) & 101 & / ( e1t(ji,jj) * e2t(ji,jj) ) 85 zfact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) / ( e1t(ji,jj) * e2t(ji,jj) ) 102 86 END DO 103 87 END DO … … 110 94 iter = 0 111 95 112 ! !=================== 113 DO WHILE ( ( zconv > zeps ) .AND. (iter <= its) ) ! Sub-time step loop 114 ! !=================== 115 ! incrementation of the sub-time step number 116 iter = iter + 1 96 ! !======================! 97 DO WHILE ( ( zconv > zeps ) .AND. (iter <= its) ) ! Sub-time step loop ! 98 ! !======================! 99 iter = iter + 1 ! incrementation of the sub-time step number 117 100 118 ! diffusive fluxes in U- and V- direction 119 DO jj = 1, jpjm1 101 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 120 102 DO ji = 1 , fs_jpim1 ! vector opt. 121 103 zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) … … 123 105 END DO 124 106 END DO 125 126 ! diffusive trend : divergence of the fluxes 127 DO jj= 2, jpjm1 107 DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes 128 108 DO ji = fs_2 , fs_jpim1 ! vector opt. 129 109 zdiv (ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj ) & … … 131 111 END DO 132 112 END DO 133 134 ! save the first evaluation of the diffusive trend in zdiv0 113 ! ! save the first evaluation of the diffusive trend in zdiv0 135 114 IF( iter == 1 ) zdiv0(:,:) = zdiv(:,:) 136 115 137 ! XXXX iterative evaluation????? 138 DO jj = 2, jpjm1 116 DO jj = 2, jpjm1 ! XXXX iterative evaluation????? 139 117 DO ji = fs_2 , fs_jpim1 ! vector opt. 140 zrlxint = ( ptab0(ji,jj) &118 zrlxint = ( ztab0(ji,jj) & 141 119 & + rdt_ice * ( zalfa * ( zdiv(ji,jj) + zfact(ji,jj) * ptab(ji,jj) ) & 142 120 & + ( 1.0 - zalfa ) * zdiv0(ji,jj) ) ) & … … 145 123 END DO 146 124 END DO 147 148 ! lateral boundary condition on ptab149 125 CALL lbc_lnk( zrlx, 'T', 1. ) 150 126 151 ! convergence test 152 zconv = 0.e0 127 zconv = 0.e0 ! convergence test 153 128 DO jj = 2, jpjm1 154 129 DO ji = 2, jpim1 … … 157 132 END DO 158 133 IF( lk_mpp ) CALL mpp_max( zconv ) ! max over the global domain 159 160 ptab(:,:) = zrlx(:,:) 161 162 ! !========================== 163 END DO ! end of sub-time step loop 164 ! !========================== 134 ! 135 ptab(:,:) = zrlx(:,:) ! update value 136 ! !=============================! 137 END DO ! end of sub-time step loop ! 138 ! !=============================! 165 139 166 140 IF(ln_ctl) THEN 167 zrlx(:,:) = ptab(:,:) - ptab0(:,:)141 zrlx(:,:) = ptab(:,:) - ztab0(:,:) 168 142 WRITE(charout,FMT="(' lim_hdf : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter 169 CALL prt_ctl( tab2d_1=zrlx, clinfo1=charout)143 CALL prt_ctl( tab2d_1=zrlx, clinfo1=charout ) 170 144 ENDIF 171 145 ! 172 146 END SUBROUTINE lim_hdf_2 173 147
Note: See TracChangeset
for help on using the changeset viewer.
