[825] | 1 | MODULE limcons |
---|
[2715] | 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 | !!---------------------------------------------------------------------- |
---|
[834] | 10 | #if defined key_lim3 |
---|
| 11 | !!---------------------------------------------------------------------- |
---|
| 12 | !! 'key_lim3' : LIM3 sea-ice model |
---|
| 13 | !!---------------------------------------------------------------------- |
---|
[2715] | 14 | !! lim_cons : checks whether energy, mass and salt are conserved |
---|
[825] | 15 | !!---------------------------------------------------------------------- |
---|
[2715] | 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 |
---|
[825] | 22 | |
---|
| 23 | IMPLICIT NONE |
---|
| 24 | PRIVATE |
---|
| 25 | |
---|
[2715] | 26 | PUBLIC lim_column_sum |
---|
| 27 | PUBLIC lim_column_sum_energy |
---|
| 28 | PUBLIC lim_cons_check |
---|
[825] | 29 | |
---|
| 30 | !!---------------------------------------------------------------------- |
---|
[2715] | 31 | !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) |
---|
[1156] | 32 | !! $Id$ |
---|
[2715] | 33 | !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) |
---|
[825] | 34 | !!---------------------------------------------------------------------- |
---|
| 35 | CONTAINS |
---|
| 36 | |
---|
[2715] | 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 | ! |
---|
[825] | 59 | END SUBROUTINE lim_column_sum |
---|
| 60 | |
---|
| 61 | |
---|
[2715] | 62 | SUBROUTINE lim_column_sum_energy( ksum, klay, pin, pout) |
---|
[825] | 63 | !!------------------------------------------------------------------- |
---|
| 64 | !! *** ROUTINE lim_column_sum_energy *** |
---|
| 65 | !! |
---|
| 66 | !! ** Purpose : Compute the sum of xin over nsum categories |
---|
| 67 | !! and nlay layers |
---|
| 68 | !! |
---|
| 69 | !! ** Method : Arithmetics |
---|
| 70 | !!--------------------------------------------------------------------- |
---|
[2715] | 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 |
---|
[825] | 77 | !!--------------------------------------------------------------------- |
---|
[2715] | 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 | ! |
---|
[825] | 86 | END SUBROUTINE lim_column_sum_energy |
---|
| 87 | |
---|
[921] | 88 | |
---|
[2715] | 89 | SUBROUTINE lim_cons_check( px1, px2, pmax_err, cd_fieldid ) |
---|
[825] | 90 | !!------------------------------------------------------------------- |
---|
| 91 | !! *** ROUTINE lim_cons_check *** |
---|
| 92 | !! |
---|
| 93 | !! ** Purpose : Test the conservation of a certain variable |
---|
| 94 | !! For each physical grid cell, check that initial |
---|
| 95 | !! and final values |
---|
| 96 | !! of a conserved field are equal to within a small value. |
---|
| 97 | !! |
---|
| 98 | !! ** Method : |
---|
| 99 | !!--------------------------------------------------------------------- |
---|
[2715] | 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 |
---|
[825] | 109 | !!--------------------------------------------------------------------- |
---|
[2715] | 110 | ! |
---|
| 111 | IF(lwp) WRITE(numout,*) ' lim_cons_check ' |
---|
| 112 | IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' |
---|
[825] | 113 | |
---|
[2715] | 114 | llconserv_err = .FALSE. |
---|
| 115 | inb_error = 0 |
---|
| 116 | zmean_error = 0._wp |
---|
| 117 | IF( MAXVAL( px2(:,:) - px1(:,:) ) > pmax_err ) llconserv_err = .TRUE. |
---|
[825] | 118 | |
---|
[2715] | 119 | IF( llconserv_err ) THEN |
---|
[825] | 120 | DO jj = 1, jpj |
---|
| 121 | DO ji = 1, jpi |
---|
[2715] | 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 |
---|
[825] | 135 | ENDIF |
---|
| 136 | END DO |
---|
| 137 | END DO |
---|
[2715] | 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 | ! |
---|
[825] | 150 | END SUBROUTINE lim_cons_check |
---|
| 151 | |
---|
[834] | 152 | #else |
---|
| 153 | !!---------------------------------------------------------------------- |
---|
| 154 | !! Default option Empty module NO LIM sea-ice model |
---|
| 155 | !!---------------------------------------------------------------------- |
---|
| 156 | #endif |
---|
| 157 | !!====================================================================== |
---|
| 158 | END MODULE limcons |
---|