- Timestamp:
- 2011-02-20T16:29:08+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90
r2590 r2600 4 4 !! LIM 2.0 ice model : horizontal diffusion of sea-ice quantities 5 5 !!====================================================================== 6 !! History : LIM ! 2000-01 (LIM) Original code 7 !! - ! 2001-05 (G. Madec, R. Hordoir) opa norm 8 !! 1.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: ice variables 18 USE lbclnk ! lateral boundary condition - MPP exchanges 19 USE lib_mpp ! MPP library 20 USE prtctl ! Print control 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 25 PUBLIC lim_hdf_alloc_2 ! called by nemogcm 26 PUBLIC lim_hdf_2 ! called by limtrp_2.F90 27 PUBLIC lim_hdf_alloc_2 ! called by nemogcm.F90 26 28 27 !! * Module variables28 LOGICAL :: linit = .TRUE. ! ???29 REAL(wp) :: epsi04 = 1e-04 ! constant30 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfact ! ???29 LOGICAL :: linit = .TRUE. ! ! initialization flag (set to flase after the 1st call) 30 REAL(wp) :: epsi04 = 1e-04 ! constant 31 32 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: efact ! ??? 31 33 32 34 !! * Substitution 33 35 # include "vectopt_loop_substitute.h90" 34 36 !!---------------------------------------------------------------------- 35 !! NEMO/LIM2 3.3, UCL - NEMO Consortium (2010)37 !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2010) 36 38 !! $Id$ 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 38 40 !!---------------------------------------------------------------------- 39 40 41 CONTAINS 41 42 … … 44 45 !! *** ROUTINE lim_hdf_alloc_2 *** 45 46 !!------------------------------------------------------------------- 46 IMPLICIT none47 47 INTEGER :: lim_hdf_alloc_2 48 48 !!------------------------------------------------------------------- 49 50 ALLOCATE( zfact(jpi,jpj), Stat=lim_hdf_alloc_2)51 52 IF( lim_hdf_alloc_2 /= 0)THEN53 CALL ctl_warn( 'lim_hdf_alloc_2: failed to allocate zfact array.')54 END 55 49 ! 50 ALLOCATE( efact(jpi,jpj) , STAT=lim_hdf_alloc_2 ) 51 ! 52 IF( lim_hdf_alloc_2 /= 0 ) THEN 53 CALL ctl_warn( 'lim_hdf_alloc_2: failed to allocate efact array.' ) 54 ENDIF 55 ! 56 56 END FUNCTION lim_hdf_alloc_2 57 57 … … 61 61 !! *** ROUTINE lim_hdf_2 *** 62 62 !! 63 !! ** purpose : Compute and add the diffusive trend on sea-ice 64 !! variables 63 !! ** purpose : Compute and add the diffusive trend on sea-ice variables 65 64 !! 66 65 !! ** method : Second order diffusive operator evaluated using a 67 !! Cranck-Nicholson time Scheme.66 !! Cranck-Nicholson time Scheme. 68 67 !! 69 68 !! ** Action : update ptab with the diffusive contribution 70 !!71 !! History :72 !! ! 00-01 (LIM) Original code73 !! ! 01-05 (G. Madec, R. Hordoir) opa norm74 !! ! 02-08 (C. Ethe) F90, free form75 69 !!------------------------------------------------------------------- 76 70 USE wrk_nemo, ONLY: wrk_use, wrk_release 77 USE wrk_nemo, ONLY: zrlx => wrk_2d_11, zflu => wrk_2d_12 78 USE wrk_nemo, ONLY: zflv => wrk_2d_13, ptab0 => wrk_2d_14 79 USE wrk_nemo, ONLY: zdiv0 => wrk_2d_15, zdiv => wrk_2d_16 80 !! 81 ! * Arguments 82 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: & 83 ptab ! Field on which the diffusion is applied 84 85 ! * Local variables 86 INTEGER :: ji, jj ! dummy loop indices 87 INTEGER :: & 88 its, iter ! temporary integers 71 USE wrk_nemo, ONLY: zflu => wrk_2d_11, zdiv => wrk_2d_13, zrlx => wrk_2d_15 72 USE wrk_nemo, ONLY: zflv => wrk_2d_12, zdiv0 => wrk_2d_14, ztab0 => wrk_2d_16 73 ! 74 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: ptab ! Field on which the diffusion is applied 75 ! 76 INTEGER :: ji, jj ! dummy loop indices 77 INTEGER :: its, iter ! local integers 78 REAL(wp) :: zalfa, zrlxint, zconv, zeps ! local scalars 89 79 CHARACTER (len=55) :: charout 90 REAL(wp) :: &91 zalfa, zrlxint, zconv, zeps ! temporary scalars92 80 !!------------------------------------------------------------------- 93 81 94 IF(.NOT. wrk_use(2, 11,12,13,14,15,16))THEN 95 CALL ctl_stop('lim_hdf_2 : requested workspace arrays unavailable.') 96 RETURN 82 IF( .NOT. wrk_use(2, 11,12,13,14,15,16) ) THEN 83 CALL ctl_stop( 'lim_hdf_2 : requested workspace arrays unavailable.' ) ; RETURN 97 84 END IF 98 85 99 ! Initialisation 100 ! --------------- 101 ! Time integration parameters 102 zalfa = 0.5 ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 103 its = 100 ! Maximum number of iteration 104 zeps = 2. * epsi04 105 106 ! Arrays initialization 107 ptab0 (:, : ) = ptab(:,:) 108 !bug zflu (:,jpj) = 0.e0 109 !bug zflv (:,jpj) = 0.e0 110 zdiv0(:, 1 ) = 0.e0 111 zdiv0(:,jpj) = 0.e0 112 IF( .NOT.lk_vopt_loop ) THEN 113 zflu (jpi,:) = 0.e0 114 zflv (jpi,:) = 0.e0 115 zdiv0(1, :) = 0.e0 116 zdiv0(jpi,:) = 0.e0 117 ENDIF 118 119 ! Metric coefficient (compute at the first call and saved in 120 IF( linit ) THEN 86 ! !== Initialisation ==! 87 ! 88 IF( linit ) THEN ! Metric coefficient (compute at the first call and saved in efact) 121 89 DO jj = 2, jpjm1 122 90 DO ji = fs_2 , fs_jpim1 ! vector opt. 123 zfact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj ) + e1v(ji,jj) + e1v(ji,jj-1) ) &91 efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj ) + e1v(ji,jj) + e1v(ji,jj-1) ) & 124 92 & / ( e1t(ji,jj) * e2t(ji,jj) ) 125 93 END DO … … 127 95 linit = .FALSE. 128 96 ENDIF 97 ! 98 ! ! Time integration parameters 99 zalfa = 0.5_wp ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 100 its = 100 ! Maximum number of iteration 101 zeps = 2._wp * epsi04 102 ! 103 ztab0(:, : ) = ptab(:,:) ! Arrays initialization 104 zdiv0(:, 1 ) = 0._wp 105 zdiv0(:,jpj) = 0._wp 106 IF( .NOT.lk_vopt_loop ) THEN 107 zflu (jpi,:) = 0._wp 108 zflv (jpi,:) = 0._wp 109 zdiv0(1, :) = 0._wp 110 zdiv0(jpi,:) = 0._wp 111 ENDIF 129 112 130 131 ! Sub-time step loop 132 zconv = 1.e0 113 zconv = 1._wp !== horizontal diffusion using a Crant-Nicholson scheme ==! 133 114 iter = 0 134 135 ! !=================== 136 DO WHILE ( ( zconv > zeps ) .AND. (iter <= its) ) ! Sub-time step loop 137 ! !=================== 138 ! incrementation of the sub-time step number 139 iter = iter + 1 140 141 ! diffusive fluxes in U- and V- direction 142 DO jj = 1, jpjm1 115 ! 116 DO WHILE ( zconv > zeps .AND. iter <= its ) ! Sub-time step loop 117 ! 118 iter = iter + 1 ! incrementation of the sub-time step number 119 ! 120 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 143 121 DO ji = 1 , fs_jpim1 ! vector opt. 144 122 zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) … … 146 124 END DO 147 125 END DO 148 149 ! diffusive trend : divergence of the fluxes 150 DO jj= 2, jpjm1 126 ! 127 DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes 151 128 DO ji = fs_2 , fs_jpim1 ! vector opt. 152 129 zdiv (ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj ) & … … 154 131 END DO 155 132 END DO 156 157 ! save the first evaluation of the diffusive trend in zdiv0 158 IF( iter == 1 ) zdiv0(:,:) = zdiv(:,:) 159 160 ! XXXX iterative evaluation????? 161 DO jj = 2, jpjm1 133 ! 134 IF( iter == 1 ) zdiv0(:,:) = zdiv(:,:) ! save the 1st evaluation of the diffusive trend in zdiv0 135 ! 136 DO jj = 2, jpjm1 ! iterative evaluation 162 137 DO ji = fs_2 , fs_jpim1 ! vector opt. 163 zrlxint = ( ptab0(ji,jj) &164 & + rdt_ice * ( zalfa * ( zdiv(ji,jj) + zfact(ji,jj) * ptab(ji,jj) ) &138 zrlxint = ( ztab0(ji,jj) & 139 & + rdt_ice * ( zalfa * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj) ) & 165 140 & + ( 1.0 - zalfa ) * zdiv0(ji,jj) ) ) & 166 & / ( 1.0 + zalfa * rdt_ice * zfact(ji,jj) )141 & / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) ) 167 142 zrlx(ji,jj) = ptab(ji,jj) + om * ( zrlxint - ptab(ji,jj) ) 168 143 END DO 169 144 END DO 145 CALL lbc_lnk( zrlx, 'T', 1. ) ! lateral boundary condition 170 146 171 ! lateral boundary condition on ptab 172 CALL lbc_lnk( zrlx, 'T', 1. ) 147 zconv = 0._wp ! convergence test 173 148 174 ! convergence test175 zconv = 0.e0176 149 DO jj = 2, jpjm1 177 150 DO ji = 2, jpim1 … … 179 152 END DO 180 153 END DO 181 IF( lk_mpp ) CALL mpp_max( zconv ) ! max over the global domain154 IF( lk_mpp ) CALL mpp_max( zconv ) ! max over the global domain 182 155 183 156 ptab(:,:) = zrlx(:,:) 184 185 ! !========================== 186 END DO ! end of sub-time step loop 187 ! !========================== 157 ! 158 END DO ! end of sub-time step loop 188 159 189 160 IF(ln_ctl) THEN 190 zrlx(:,:) = ptab(:,:) - ptab0(:,:)161 zrlx(:,:) = ptab(:,:) - ztab0(:,:) 191 162 WRITE(charout,FMT="(' lim_hdf : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter 192 CALL prt_ctl( tab2d_1=zrlx, clinfo1=charout)163 CALL prt_ctl( tab2d_1=zrlx, clinfo1=charout ) 193 164 ENDIF 194 195 IF(.NOT. wrk_release(2, 11,12,13,14,15,16))THEN 196 CALL ctl_stop('lim_hdf_2 : failed to release workspace arrays.') 197 RETURN 165 ! 166 IF( .NOT. wrk_release(2, 11,12,13,14,15,16) ) THEN 167 CALL ctl_stop( 'lim_hdf_2 : failed to release workspace arrays.' ) ; RETURN 198 168 END IF 199 169 ! 200 170 END SUBROUTINE lim_hdf_2 201 171
Note: See TracChangeset
for help on using the changeset viewer.
