Changeset 2715 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
r2528 r2715 1 1 MODULE limcons 2 !!====================================================================== 3 !! *** MODULE limcons *** 4 !! LIM-3 Sea Ice : conservation check 5 !!====================================================================== 6 !! History : - ! Original code from William H. Lipscomb, LANL 7 !! 3.0 ! 2004-06 (M. Vancoppenolle) Energy Conservation 8 !! 4.0 ! 2011-02 (G. Madec) add mpp considerations 9 !!---------------------------------------------------------------------- 2 10 #if defined key_lim3 3 11 !!---------------------------------------------------------------------- 4 12 !! 'key_lim3' : LIM3 sea-ice model 5 13 !!---------------------------------------------------------------------- 6 !! 7 !!====================================================================== 8 !! *** MODULE limcons *** 9 !! 10 !! This module checks whether 11 !! Ice Total Energy 12 !! Ice Total Mass 13 !! Salt Mass 14 !! Are conserved ! 15 !! 16 !!====================================================================== 17 !! lim_cons : checks whether energy/mass are conserved 14 !! lim_cons : checks whether energy, mass and salt are conserved 18 15 !!---------------------------------------------------------------------- 19 !! 20 !! * Modules used 21 22 USE par_ice 23 USE dom_oce 24 USE dom_ice 25 USE ice 26 USE in_out_manager ! I/O manager 16 USE par_ice ! LIM-3 parameter 17 USE ice ! LIM-3 variables 18 USE dom_ice ! LIM-3 domain 19 USE dom_oce ! ocean domain 20 USE in_out_manager ! I/O manager 21 USE lib_mpp ! MPP library 27 22 28 23 IMPLICIT NONE 29 24 PRIVATE 30 25 31 !! * Accessibility 32 PUBLIC lim_column_sum 33 PUBLIC lim_column_sum_energy 34 PUBLIC lim_cons_check 35 36 !! * Module variables 37 !!---------------------------------------------------------------------- 38 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010) 39 !! $Id$ 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 26 PUBLIC lim_column_sum 27 PUBLIC lim_column_sum_energy 28 PUBLIC lim_cons_check 42 29 43 30 !!---------------------------------------------------------------------- 44 31 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 32 !! $Id$ 33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 34 !!---------------------------------------------------------------------- 45 35 CONTAINS 46 36 47 !=============================================================================== 48 49 SUBROUTINE lim_column_sum(nsum,xin,xout) 50 ! !!------------------------------------------------------------------- 51 ! !! *** ROUTINE lim_column_sum *** 52 ! !! 53 ! !! ** Purpose : Compute the sum of xin over nsum categories 54 ! !! 55 ! !! ** Method : Arithmetics 56 ! !! 57 ! !! ** Action : Gets xin(ji,jj,jl) and computes xout(ji,jj) 58 ! !! 59 ! !! History : 60 ! !! author: William H. Lipscomb, LANL 61 ! !! 2.1 ! 04-06 (M. Vancoppenolle) Energy Conservation 62 ! !!--------------------------------------------------------------------- 63 ! !! * Local variables 64 INTEGER, INTENT(in) :: & 65 nsum ! number of categories/layers 66 67 REAL (wp), DIMENSION(jpi, jpj, jpl), INTENT(IN) :: & 68 xin ! input field 69 70 REAL (wp), DIMENSION(jpi, jpj), INTENT(OUT) :: & 71 xout ! output field 72 INTEGER :: & 73 ji, jj, jl ! horizontal indices 74 75 ! !!--------------------------------------------------------------------- 76 ! WRITE(numout,*) ' lim_column_sum ' 77 ! WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 78 79 xout(:,:) = 0.00 80 81 DO jl = 1, nsum 82 DO jj = 1, jpj 83 DO ji = 1, jpi 84 xout(ji,jj) = xout(ji,jj) + xin(ji,jj,jl) 85 END DO ! ji 86 END DO ! jj 87 END DO ! jl 88 37 SUBROUTINE lim_column_sum( ksum, pin, pout ) 38 !!------------------------------------------------------------------- 39 !! *** ROUTINE lim_column_sum *** 40 !! 41 !! ** Purpose : Compute the sum of xin over nsum categories 42 !! 43 !! ** Method : Arithmetics 44 !! 45 !! ** Action : Gets xin(ji,jj,jl) and computes xout(ji,jj) 46 !!--------------------------------------------------------------------- 47 INTEGER , INTENT(in ) :: ksum ! number of categories/layers 48 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pin ! input field 49 REAL(wp), DIMENSION(:,:) , INTENT( out) :: pout ! output field 50 ! 51 INTEGER :: jl ! dummy loop indices 52 !!--------------------------------------------------------------------- 53 ! 54 pout(:,:) = pin(:,:,1) 55 DO jl = 2, ksum 56 pout(:,:) = pout(:,:) + pin(:,:,jl) 57 END DO 58 ! 89 59 END SUBROUTINE lim_column_sum 90 60 91 !===============================================================================92 61 93 SUBROUTINE lim_column_sum_energy(nsum,nlay,xin,xout) 94 62 SUBROUTINE lim_column_sum_energy( ksum, klay, pin, pout) 95 63 !!------------------------------------------------------------------- 96 64 !! *** ROUTINE lim_column_sum_energy *** … … 100 68 !! 101 69 !! ** Method : Arithmetics 102 !!103 !! ** Action : Gets xin(ji,jj,jl) and computes xout(ji,jj)104 !!105 !! History :106 !! author: William H. Lipscomb, LANL107 !! 2.1 ! 04-06 (M. Vancoppenolle) Energy Conservation108 70 !!--------------------------------------------------------------------- 109 !! * Local variables 110 INTEGER, INTENT(in) :: & 111 nsum, & !: number of categories 112 nlay !: number of vertical layers 113 114 REAL (wp), DIMENSION(jpi, jpj, jkmax, jpl), INTENT(IN) :: & 115 xin !: input field 116 117 REAL (wp), DIMENSION(jpi, jpj), INTENT(OUT) :: & 118 xout !: output field 119 120 INTEGER :: & 121 ji, jj, & !: horizontal indices 122 jk, jl !: layer and category indices 71 INTEGER , INTENT(in ) :: ksum !: number of categories 72 INTEGER , INTENT(in ) :: klay !: number of vertical layers 73 REAL(wp), DIMENSION(jpi,jpj,jkmax,jpl), INTENT(in ) :: pin !: input field 74 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pout !: output field 75 ! 76 INTEGER :: jk, jl ! dummy loop indices 123 77 !!--------------------------------------------------------------------- 124 125 ! WRITE(numout,*) ' lim_column_sum_energy ' 126 ! WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~ ' 127 128 xout(:,:) = 0.00 129 130 DO jl = 1, nsum 131 DO jk = 1, nlay 132 DO jj = 1, jpj 133 DO ji = 1, jpi 134 xout(ji,jj) = xout(ji,jj) + xin(ji,jj,jk,jl) 135 END DO ! ji 136 END DO ! jj 137 END DO ! jk 138 END DO ! jl 139 78 ! 79 DO jl = 1, ksum 80 pout(:,:) = pin(:,:,1,jl) 81 DO jk = 2, klay 82 pout(:,:) = pout(:,:) + pin(:,:,jk,jl) 83 END DO 84 END DO 85 ! 140 86 END SUBROUTINE lim_column_sum_energy 141 87 142 !===============================================================================143 88 144 SUBROUTINE lim_cons_check( x1, x2, max_err, fieldid)89 SUBROUTINE lim_cons_check( px1, px2, pmax_err, cd_fieldid ) 145 90 !!------------------------------------------------------------------- 146 91 !! *** ROUTINE lim_cons_check *** … … 152 97 !! 153 98 !! ** Method : 154 !!155 !! ** Action : -156 !! History :157 !! author: William H. Lipscomb, LANL158 !! 2.1 ! 04-06 (M. Vancoppenolle) Energy Conservation159 99 !!--------------------------------------------------------------------- 160 !! * Local variables 100 REAL(wp), DIMENSION(:,:), INTENT(in ) :: px1 !: initial field 101 REAL(wp), DIMENSION(:,:), INTENT(in ) :: px2 !: final field 102 REAL(wp) , INTENT(in ) :: pmax_err !: max allowed error 103 CHARACTER(len=15) , INTENT(in ) :: cd_fieldid !: field identifyer 104 ! 105 INTEGER :: ji, jj ! dummy loop indices 106 INTEGER :: inb_error ! number of g.c where there is a cons. error 107 LOGICAL :: llconserv_err ! = .true. if conservation check failed 108 REAL(wp) :: zmean_error ! mean error on error points 109 !!--------------------------------------------------------------------- 110 ! 111 IF(lwp) WRITE(numout,*) ' lim_cons_check ' 112 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 161 113 162 REAL (wp), DIMENSION(jpi, jpj), INTENT(IN) :: & 163 x1 (jpi,jpj) , & !: initial field 164 x2 (jpi,jpj) !: final field 114 llconserv_err = .FALSE. 115 inb_error = 0 116 zmean_error = 0._wp 117 IF( MAXVAL( px2(:,:) - px1(:,:) ) > pmax_err ) llconserv_err = .TRUE. 165 118 166 REAL (wp) , INTENT ( IN ) :: & 167 max_err !: max allowed error 168 169 REAL (wp) :: & 170 mean_error !: mean error on error points 171 172 INTEGER :: & 173 num_error !: number of g.c where there is a cons. error 174 175 CHARACTER(len=15) , INTENT(IN) :: & 176 fieldid !: field identifyer 177 178 INTEGER :: & 179 ji, jj !: horizontal indices 180 181 LOGICAL :: & 182 conserv_err !: = .true. if conservation check failed 183 184 !!--------------------------------------------------------------------- 185 WRITE(numout,*) ' lim_cons_check ' 186 WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 187 188 conserv_err = .FALSE. 189 DO jj = 1, jpj 190 DO ji = 1, jpi 191 IF (ABS(x2(ji,jj) - x1(ji,jj)) .GT. max_err) THEN 192 conserv_err = .TRUE. 193 ENDIF 194 END DO 195 END DO 196 197 IF ( conserv_err ) THEN 198 199 num_error = 0 200 mean_error = 0.0 119 IF( llconserv_err ) THEN 201 120 DO jj = 1, jpj 202 121 DO ji = 1, jpi 203 IF (ABS(x2(ji,jj) - x1(ji,jj)) .GT.max_err ) THEN204 num_error = num_error + 1205 mean_error = mean_error + ABS(x2(ji,jj) - x1(ji,jj))206 207 WRITE (numout,*) ' ALERTE 99 '208 WRITE (numout,*) ' Conservation error: ', fieldid209 WRITE (numout,*) ' Point : ', ji, jj210 WRITE (numout,*) ' lat, lon : ', gphit(ji,jj), &211 glamt(ji,jj)212 WRITE (numout,*) ' Initial value : ',x1(ji,jj)213 WRITE (numout,*) ' Final value : ',x2(ji,jj)214 WRITE (numout,*) ' Difference : ', x2(ji,jj) -x1(ji,jj)215 122 IF( ABS( px2(ji,jj) - px1(ji,jj) ) > pmax_err ) THEN 123 inb_error = inb_error + 1 124 zmean_error = zmean_error + ABS( px2(ji,jj) - px1(ji,jj) ) 125 ! 126 IF(lwp) THEN 127 WRITE (numout,*) ' ALERTE 99 ' 128 WRITE (numout,*) ' Conservation error: ', cd_fieldid 129 WRITE (numout,*) ' Point : ', ji, jj 130 WRITE (numout,*) ' lat, lon : ', gphit(ji,jj), glamt(ji,jj) 131 WRITE (numout,*) ' Initial value : ', px1(ji,jj) 132 WRITE (numout,*) ' Final value : ', px2(ji,jj) 133 WRITE (numout,*) ' Difference : ', px2(ji,jj) - px1(ji,jj) 134 ENDIF 216 135 ENDIF 217 136 END DO 218 137 END DO 219 220 IF ( num_error .GT. 0 ) mean_error = mean_error / num_error 221 WRITE(numout,*) ' Conservation check for : ', fieldid 222 WRITE(numout,*) ' Number of error points : ', num_error 223 WRITE(numout,*) ' Mean error on these pts: ', mean_error 224 225 ENDIF ! conserv_err 226 138 ! 139 ENDIF 140 IF(lk_mpp) CALL mpp_sum( inb_error ) 141 IF(lk_mpp) CALL mpp_sum( zmean_error ) 142 ! 143 IF( inb_error > 0 .AND. lwp ) THEN 144 zmean_error = zmean_error / REAL( inb_error, wp ) 145 WRITE(numout,*) ' Conservation check for : ', cd_fieldid 146 WRITE(numout,*) ' Number of error points : ', inb_error 147 WRITE(numout,*) ' Mean error on these pts: ', zmean_error 148 ENDIF 149 ! 227 150 END SUBROUTINE lim_cons_check 228 151
Note: See TracChangeset
for help on using the changeset viewer.
