Changeset 771 for branches/dev_001_GM/NEMO/TOP_SRC/TRP/trcrad.F90
- Timestamp:
- 2007-12-17T11:51:41+01:00 (16 years ago)
- File:
-
- 1 edited
-
branches/dev_001_GM/NEMO/TOP_SRC/TRP/trcrad.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_001_GM/NEMO/TOP_SRC/TRP/trcrad.F90
r719 r771 4 4 !! Ocean passive tracers: correction of negative concentrations 5 5 !!====================================================================== 6 !! History : - ! 01-01 (O. Aumont & E. Kestenare) Original code 7 !! 1.0 ! 04-03 (C. Ethe) free form F90 8 !!---------------------------------------------------------------------- 6 9 #if defined key_passivetrc 10 !!---------------------------------------------------------------------- 11 !! 'key_passivetrc' Passive tracers 7 12 !!---------------------------------------------------------------------- 8 13 !! trc_rad : correction of negative concentrations 9 14 !!---------------------------------------------------------------------- 10 !! * Modules used11 15 USE oce_trc ! ocean dynamics and tracers variables 12 16 USE trc ! ocean passive tracers variables … … 17 21 PRIVATE 18 22 19 !! * Routine accessibility20 23 PUBLIC trc_rad ! routine called by trcstp.F90 24 21 25 !! * Substitutions 22 26 # include "passivetrc_substitute.h90" 23 27 !!---------------------------------------------------------------------- 24 !! 25 !! $ Header$26 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt28 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 29 !! $Id:$ 30 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 27 31 !!---------------------------------------------------------------------- 32 28 33 CONTAINS 29 34 … … 32 37 !! *** ROUTINE trc_rad *** 33 38 !! 34 !! ** Purpose : "crappy" routine to correct artificial negative35 !! concentrations due to isopycnal scheme39 !! ** Purpose : "crappy" routine to correct artificial negative 40 !! concentrations due to isopycnal scheme 36 41 !! 37 !! ** Method : Set negative concentrations to zero 38 !! compute the corresponding mass added to the tracers 39 !! and remove it when possible 42 !! ** Method : - PISCES or LOBSTER: Set negative concentrations to zero 43 !! while computing the corresponding tracer content that 44 !! is added to the tracers. Then, adjust the tracer 45 !! concentration using a multiplicative factor so that 46 !! the total tracer concentration is preserved. 47 !! - CFC: simply set to zero the negative CFC concentration 48 !! (the total CFC content is not strictly preserved) 49 !!---------------------------------------------------------------------- 50 INTEGER, INTENT( in ) :: kt ! ocean time-step index 40 51 !! 41 !! History : 42 !! 8.2 ! 01-01 (O. Aumont & E. Kestenare) Original code 43 !! 9.0 ! 04-03 (C. Ethe) free form F90 44 !!---------------------------------------------------------------------- 45 !! * Arguments 46 INTEGER, INTENT( in ) :: kt ! ocean time-step index 47 48 !! * Local declarations 49 INTEGER :: ji, jj, jk, jn ! dummy loop indices 50 #if defined key_trc_pisces || defined key_trc_lobster1 51 REAL(wp) :: zvolk, trcorb, trmasb ,trcorn, trmasn 52 #endif 52 INTEGER :: ji, jj, jk, jn ! dummy loop indices 53 REAL(wp) :: zvolk, ztrcorb, ztrmasb ! temporary scalars 54 REAL(wp) :: zcoef, ztrcorn, ztrmasn ! " " 53 55 CHARACTER (len=22) :: charout 54 56 !!---------------------------------------------------------------------- … … 60 62 ENDIF 61 63 62 63 #if defined key_cfc 64 DO jn = 1, jptra 65 DO jk = 1, jpkm1 66 DO jj = 1, jpj 67 DO ji = 1, jpi 68 trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) ) 69 trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) ) 70 END DO 71 END DO 72 END DO 73 END DO 74 75 #elif defined key_trc_pisces || defined key_trc_lobster1 76 77 DO jn = 1, jptra 78 trcorb = 0. 79 trmasb = 0. 80 trcorn = 0. 81 trmasn = 0. 82 DO jk = 1, jpkm1 83 DO jj = 1, jpj 84 DO ji = 1, jpi 85 zvolk = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) & 86 #if defined key_off_degrad 87 & * facvol(ji,jj,jk) & 88 #endif 89 & * tmask(ji,jj,jk) * tmask_i(ji,jj) 90 91 trcorb = trcorb + MIN( 0., trb(ji,jj,jk,jn) ) * zvolk 92 trcorn = trcorn + MIN( 0., trn(ji,jj,jk,jn) ) * zvolk 93 94 trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) ) 95 trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) ) 96 97 trmasb = trmasb + trb(ji,jj,jk,jn) * zvolk 98 trmasn = trmasn + trn(ji,jj,jk,jn) * zvolk 99 END DO 100 END DO 101 END DO 102 103 IF( lk_mpp ) THEN 104 CALL mpp_sum( trcorb ) ! sum over the global domain 105 CALL mpp_sum( trcorn ) ! sum over the global domain 106 CALL mpp_sum( trmasb ) ! sum over the global domain 107 CALL mpp_sum( trmasn ) ! sum over the global domain 108 ENDIF 109 110 IF( trcorb /= 0 ) THEN 111 DO jk = 1, jpkm1 112 DO jj = 1, jpj 113 DO ji = 1, jpi 114 trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) ) 115 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) * ( 1. + trcorb/trmasb ) * tmask(ji,jj,jk) 116 END DO 117 END DO 118 END DO 119 ENDIF 120 121 IF( trcorn /= 0) THEN 64 IF( lk_trc_cfc ) THEN ! CFC model 65 DO jn = 1, jptra 122 66 DO jk = 1, jpkm1 123 67 DO jj = 1, jpj 124 68 DO ji = 1, jpi 125 69 trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) ) 126 tr n(ji,jj,jk,jn) = trn(ji,jj,jk,jn) * ( 1. + trcorn/trmasn ) * tmask(ji,jj,jk)70 trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) ) 127 71 END DO 128 72 END DO 129 73 END DO 130 ENDIF 74 END DO 75 ENDIF 131 76 132 END DO 133 134 #endif 77 IF( lk_trc_pisces .OR. lk_trc_lobster ) THEN ! PISCES or LOBSTER bio-model 78 DO jn = 1, jptra 79 ztrcorb = 0.e0 80 ztrmasb = 0.e0 81 ztrcorn = 0.e0 82 ztrmasn = 0.e0 83 DO jk = 1, jpkm1 84 DO jj = 1, jpj 85 DO ji = 1, jpi 86 zvolk = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) & 87 # if defined key_off_degrad 88 & * facvol(ji,jj,jk) & 89 # endif 90 & * tmask(ji,jj,jk) * tmask_i(ji,jj) 135 91 136 IF(ln_ctl) THEN ! print mean trends (used for debugging) 92 ztrcorb = ztrcorb + MIN( 0., trb(ji,jj,jk,jn) ) * zvolk 93 ztrcorn = ztrcorn + MIN( 0., trn(ji,jj,jk,jn) ) * zvolk 94 95 trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) ) 96 trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) ) 97 98 ztrmasb = ztrmasb + trb(ji,jj,jk,jn) * zvolk 99 ztrmasn = ztrmasn + trn(ji,jj,jk,jn) * zvolk 100 END DO 101 END DO 102 END DO 103 IF( lk_mpp ) THEN 104 CALL mpp_sum( ztrcorb ) ! sum over the global domain 105 CALL mpp_sum( ztrcorn ) ! sum over the global domain 106 CALL mpp_sum( ztrmasb ) ! sum over the global domain 107 CALL mpp_sum( ztrmasn ) ! sum over the global domain 108 ENDIF 109 110 IF( ztrcorb /= 0 ) THEN 111 zcoef = 1. + ztrcorb / ztrmasb 112 DO jk = 1, jpkm1 113 DO jj = 1, jpj 114 DO ji = 1, jpi 115 trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) ) !!gm bug already done just above 116 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) * zcoef * tmask(ji,jj,jk) 117 END DO 118 END DO 119 END DO 120 ENDIF 121 122 IF( ztrcorn /= 0 ) THEN 123 zcoef = 1. + ztrcorn / ztrmasn 124 DO jk = 1, jpkm1 125 DO jj = 1, jpj 126 DO ji = 1, jpi 127 trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) ) !!gm bug already done just above 128 trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) * zcoef * tmask(ji,jj,jk) 129 END DO 130 END DO 131 END DO 132 ENDIF 133 ! 134 END DO 135 ! 136 ENDIF 137 ! 138 IF(ln_ctl) THEN ! print mean trends (used for debugging) 137 139 WRITE(charout, FMT="('rad')") 138 CALL prt_ctl_trc_info( charout)139 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm)140 CALL prt_ctl_trc_info( charout ) 141 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 140 142 ENDIF 141 142 143 ! 143 144 END SUBROUTINE trc_rad 144 145 145 146 #else 146 147 !!---------------------------------------------------------------------- 147 !! Dummy module : NO passive tracer148 !! Dummy module : NO TOP model 148 149 !!---------------------------------------------------------------------- 149 150 CONTAINS 150 SUBROUTINE trc_rad (kt ) ! Empty routine151 INTEGER, INTENT(in) :: kt151 SUBROUTINE trc_rad( kt ) ! Empty routine 152 INTEGER, INTENT(in) :: kt 152 153 WRITE(*,*) 'trc_rad: You should not have seen this print! error?', kt 153 154 END SUBROUTINE trc_rad
Note: See TracChangeset
for help on using the changeset viewer.
