MODULE limcons #if defined key_lim3 !!---------------------------------------------------------------------- !! 'key_lim3' : LIM3 sea-ice model !!---------------------------------------------------------------------- !! !!====================================================================== !! *** MODULE limcons *** !! !! This module checks whether !! Ice Total Energy !! Ice Total Mass !! Salt Mass !! Are conserved ! !! !!====================================================================== !! lim_cons : checks whether energy/mass are conserved !!---------------------------------------------------------------------- !! !! * Modules used USE par_ice USE dom_oce USE dom_ice USE ice USE ice_oce ! ice variables USE in_out_manager ! I/O manager IMPLICIT NONE PRIVATE !! * Accessibility PUBLIC lim_column_sum PUBLIC lim_column_sum_energy PUBLIC lim_cons_check !! * Module variables !!---------------------------------------------------------------------- !! LIM 3.0 , UCL-ASTR-LODYC-IPSL (2008) !!---------------------------------------------------------------------- CONTAINS !=============================================================================== SUBROUTINE lim_column_sum(nsum,xin,xout) ! !!------------------------------------------------------------------- ! !! *** ROUTINE lim_column_sum *** ! !! ! !! ** Purpose : Compute the sum of xin over nsum categories ! !! ! !! ** Method : Arithmetics ! !! ! !! ** Action : Gets xin(ji,jj,jl) and computes xout(ji,jj) ! !! ! !! History : ! !! author: William H. Lipscomb, LANL ! !! 2.1 ! 04-06 (M. Vancoppenolle) Energy Conservation ! !!--------------------------------------------------------------------- ! !! * Local variables INTEGER, INTENT(in) :: & nsum ! number of categories/layers REAL (wp), DIMENSION(jpi, jpj, jpl), INTENT(IN) :: & xin ! input field REAL (wp), DIMENSION(jpi, jpj), INTENT(OUT) :: & xout ! output field INTEGER :: & ji, jj, jl ! horizontal indices ! !!--------------------------------------------------------------------- ! WRITE(numout,*) ' lim_column_sum ' ! WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' xout(:,:) = 0.00 DO jl = 1, nsum DO jj = 1, jpj DO ji = 1, jpi xout(ji,jj) = xout(ji,jj) + xin(ji,jj,jl) END DO ! ji END DO ! jj END DO ! jl END SUBROUTINE lim_column_sum !=============================================================================== SUBROUTINE lim_column_sum_energy(nsum,nlay,xin,xout) !!------------------------------------------------------------------- !! *** ROUTINE lim_column_sum_energy *** !! !! ** Purpose : Compute the sum of xin over nsum categories !! and nlay layers !! !! ** Method : Arithmetics !! !! ** Action : Gets xin(ji,jj,jl) and computes xout(ji,jj) !! !! History : !! author: William H. Lipscomb, LANL !! 2.1 ! 04-06 (M. Vancoppenolle) Energy Conservation !!--------------------------------------------------------------------- !! * Local variables INTEGER, INTENT(in) :: & nsum, & !: number of categories nlay !: number of vertical layers REAL (wp), DIMENSION(jpi, jpj, jkmax, jpl), INTENT(IN) :: & xin !: input field REAL (wp), DIMENSION(jpi, jpj), INTENT(OUT) :: & xout !: output field INTEGER :: & ji, jj, & !: horizontal indices jk, jl !: layer and category indices !!--------------------------------------------------------------------- ! WRITE(numout,*) ' lim_column_sum_energy ' ! WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~ ' xout(:,:) = 0.00 DO jl = 1, nsum DO jk = 1, nlay DO jj = 1, jpj DO ji = 1, jpi xout(ji,jj) = xout(ji,jj) + xin(ji,jj,jk,jl) END DO ! ji END DO ! jj END DO ! jk END DO ! jl END SUBROUTINE lim_column_sum_energy !=============================================================================== SUBROUTINE lim_cons_check(x1, x2, max_err, fieldid) !!------------------------------------------------------------------- !! *** ROUTINE lim_cons_check *** !! !! ** Purpose : Test the conservation of a certain variable !! For each physical grid cell, check that initial !! and final values !! of a conserved field are equal to within a small value. !! !! ** Method : !! !! ** Action : - !! History : !! author: William H. Lipscomb, LANL !! 2.1 ! 04-06 (M. Vancoppenolle) Energy Conservation !!--------------------------------------------------------------------- !! * Local variables REAL (wp), DIMENSION(jpi, jpj), INTENT(IN) :: & x1 (jpi,jpj) , & !: initial field x2 (jpi,jpj) !: final field REAL (wp) , INTENT ( IN ) :: & max_err !: max allowed error REAL (wp) :: & mean_error !: mean error on error points INTEGER :: & num_error !: number of g.c where there is a cons. error CHARACTER(len=15) , INTENT(IN) :: & fieldid !: field identifyer INTEGER :: & ji, jj !: horizontal indices LOGICAL :: & conserv_err !: = .true. if conservation check failed !!--------------------------------------------------------------------- WRITE(numout,*) ' lim_cons_check ' WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' conserv_err = .FALSE. DO jj = 1, jpj DO ji = 1, jpi IF (ABS(x2(ji,jj) - x1(ji,jj)) .GT. max_err) THEN conserv_err = .TRUE. ENDIF END DO END DO IF ( conserv_err ) THEN num_error = 0 mean_error = 0.0 DO jj = 1, jpj DO ji = 1, jpi IF (ABS(x2(ji,jj) - x1(ji,jj)) .GT. max_err ) THEN num_error = num_error + 1 mean_error = mean_error + ABS(x2(ji,jj) - x1(ji,jj)) WRITE (numout,*) ' ALERTE 99 ' WRITE (numout,*) ' Conservation error: ', fieldid WRITE (numout,*) ' Point : ', ji, jj WRITE (numout,*) ' lat, lon : ', gphit(ji,jj), & glamt(ji,jj) WRITE (numout,*) ' Initial value : ', x1(ji,jj) WRITE (numout,*) ' Final value : ', x2(ji,jj) WRITE (numout,*) ' Difference : ', x2(ji,jj) - x1(ji,jj) ENDIF END DO END DO IF ( num_error .GT. 0 ) mean_error = mean_error / num_error WRITE(numout,*) ' Conservation check for : ', fieldid WRITE(numout,*) ' Number of error points : ', num_error WRITE(numout,*) ' Mean error on these pts: ', mean_error ENDIF ! conserv_err END SUBROUTINE lim_cons_check #else !!---------------------------------------------------------------------- !! Default option Empty module NO LIM sea-ice model !!---------------------------------------------------------------------- #endif !!====================================================================== END MODULE limcons