- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/TOP/PISCES/P4Z/p4zagg.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zagg.F90
r10069 r13463 17 17 USE trc ! passive tracers common variables 18 18 USE sms_pisces ! PISCES Source Minus Sink variables 19 USE prtctl _trc! print control for debugging19 USE prtctl ! print control for debugging 20 20 21 21 IMPLICIT NONE … … 24 24 PUBLIC p4z_agg ! called in p4zbio.F90 25 25 26 !! * Substitutions 27 # include "do_loop_substitute.h90" 26 28 !!---------------------------------------------------------------------- 27 29 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 31 33 CONTAINS 32 34 33 SUBROUTINE p4z_agg ( kt, knt )35 SUBROUTINE p4z_agg ( kt, knt, Kbb, Krhs ) 34 36 !!--------------------------------------------------------------------- 35 37 !! *** ROUTINE p4z_agg *** … … 40 42 !!--------------------------------------------------------------------- 41 43 INTEGER, INTENT(in) :: kt, knt ! 44 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 42 45 ! 43 46 INTEGER :: ji, jj, jk … … 57 60 IF( ln_p4z ) THEN 58 61 ! 59 DO jk = 1, jpkm1 60 DO jj = 1, jpj 61 DO ji = 1, jpi 62 ! 63 zfact = xstep * xdiss(ji,jj,jk) 64 ! Part I : Coagulation dependent on turbulence 65 zagg1 = 25.9 * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc) 66 zagg2 = 4452. * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc) 62 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 63 ! 64 zfact = xstep * xdiss(ji,jj,jk) 65 ! Part I : Coagulation dependent on turbulence 66 zagg1 = 25.9 * zfact * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jppoc,Kbb) 67 zagg2 = 4452. * zfact * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpgoc,Kbb) 67 68 68 69 ! Part II : Differential settling 69 70 70 71 zagg3 = 47.1 * xstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)72 zagg4 = 3.3 * xstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)71 ! Aggregation of small into large particles 72 zagg3 = 47.1 * xstep * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpgoc,Kbb) 73 zagg4 = 3.3 * xstep * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jppoc,Kbb) 73 74 74 75 zaggfe = zagg * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn )75 zagg = zagg1 + zagg2 + zagg3 + zagg4 76 zaggfe = zagg * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 76 77 77 78 79 80 81 zaggdoc = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact &82 & + 2.4 * xstep * trb(ji,jj,jk,jppoc) ) * 0.3 * trb(ji,jj,jk,jpdoc)83 84 85 86 zaggdoc2 = ( 3.53E3 * zfact + 0.1 * xstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc)87 88 zaggdoc3 = 114. * 0.3 * trb(ji,jj,jk,jpdoc) *xstep * 0.3 * trb(ji,jj,jk,jpdoc)78 ! Aggregation of DOC to POC : 79 ! 1st term is shear aggregation of DOC-DOC 80 ! 2nd term is shear aggregation of DOC-POC 81 ! 3rd term is differential settling of DOC-POC 82 zaggdoc = ( ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * zfact & 83 & + 2.4 * xstep * tr(ji,jj,jk,jppoc,Kbb) ) * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 84 ! transfer of DOC to GOC : 85 ! 1st term is shear aggregation 86 ! 2nd term is differential settling 87 zaggdoc2 = ( 3.53E3 * zfact + 0.1 * xstep ) * tr(ji,jj,jk,jpgoc,Kbb) * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 88 ! tranfer of DOC to POC due to brownian motion 89 zaggdoc3 = 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) *xstep * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 89 90 90 ! Update the trends 91 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc + zaggdoc3 92 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2 93 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 94 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 95 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3 96 ! 97 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zagg + zaggdoc + zaggdoc3 98 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zagg + zaggdoc2 99 ! 100 END DO 101 END DO 102 END DO 91 ! Update the trends 92 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zagg + zaggdoc + zaggdoc3 93 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zagg + zaggdoc2 94 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zaggfe 95 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zaggfe 96 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zaggdoc - zaggdoc2 - zaggdoc3 97 ! 98 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zagg + zaggdoc + zaggdoc3 99 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zagg + zaggdoc2 100 ! 101 END_3D 103 102 ELSE ! ln_p5z 104 103 ! 105 DO jk = 1, jpkm1 106 DO jj = 1, jpj 107 DO ji = 1, jpi 108 ! 109 zfact = xstep * xdiss(ji,jj,jk) 110 ! Part I : Coagulation dependent on turbulence 111 zaggtmp = 25.9 * zfact * trb(ji,jj,jk,jppoc) 112 zaggpoc1 = zaggtmp * trb(ji,jj,jk,jppoc) 113 zaggtmp = 4452. * zfact * trb(ji,jj,jk,jpgoc) 114 zaggpoc2 = zaggtmp * trb(ji,jj,jk,jppoc) 104 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 105 ! 106 zfact = xstep * xdiss(ji,jj,jk) 107 ! Part I : Coagulation dependent on turbulence 108 zaggtmp = 25.9 * zfact * tr(ji,jj,jk,jppoc,Kbb) 109 zaggpoc1 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 110 zaggtmp = 4452. * zfact * tr(ji,jj,jk,jpgoc,Kbb) 111 zaggpoc2 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 115 112 116 ! Part II : Differential settling 117 118 ! Aggregation of small into large particles 119 zaggtmp = 47.1 * xstep * trb(ji,jj,jk,jpgoc) 120 zaggpoc3 = zaggtmp * trb(ji,jj,jk,jppoc) 121 zaggtmp = 3.3 * xstep * trb(ji,jj,jk,jppoc) 122 zaggpoc4 = zaggtmp * trb(ji,jj,jk,jppoc) 113 ! Part II : Differential settling 123 114 124 zaggpoc = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4 125 zaggpon = zaggpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn) 126 zaggpop = zaggpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn) 127 zaggfe = zaggpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn ) 115 ! Aggregation of small into large particles 116 zaggtmp = 47.1 * xstep * tr(ji,jj,jk,jpgoc,Kbb) 117 zaggpoc3 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 118 zaggtmp = 3.3 * xstep * tr(ji,jj,jk,jppoc,Kbb) 119 zaggpoc4 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 128 120 129 ! Aggregation of DOC to POC : 130 ! 1st term is shear aggregation of DOC-DOC 131 ! 2nd term is shear aggregation of DOC-POC 132 ! 3rd term is differential settling of DOC-POC 133 zaggtmp = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact & 134 & + 2.4 * xstep * trb(ji,jj,jk,jppoc) ) 135 zaggdoc = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc) 136 zaggdon = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon) 137 zaggdop = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop) 121 zaggpoc = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4 122 zaggpon = zaggpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 123 zaggpop = zaggpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 124 zaggfe = zaggpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 138 125 139 ! transfer of DOC to GOC : 140 ! 1st term is shear aggregation 141 ! 2nd term is differential settling 142 zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * trb(ji,jj,jk,jpgoc) 143 zaggdoc2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc) 144 zaggdon2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon) 145 zaggdop2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop) 126 ! Aggregation of DOC to POC : 127 ! 1st term is shear aggregation of DOC-DOC 128 ! 2nd term is shear aggregation of DOC-POC 129 ! 3rd term is differential settling of DOC-POC 130 zaggtmp = ( ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * zfact & 131 & + 2.4 * xstep * tr(ji,jj,jk,jppoc,Kbb) ) 132 zaggdoc = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 133 zaggdon = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 134 zaggdop = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 146 135 147 ! tranfer of DOC to POC due to brownian motion 148 zaggtmp = ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) * xstep 149 zaggdoc3 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc) 150 zaggdon3 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon) 151 zaggdop3 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop) 136 ! transfer of DOC to GOC : 137 ! 1st term is shear aggregation 138 ! 2nd term is differential settling 139 zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * tr(ji,jj,jk,jpgoc,Kbb) 140 zaggdoc2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 141 zaggdon2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 142 zaggdop2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 152 143 153 ! Update the trends 154 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zaggpoc + zaggdoc + zaggdoc3 155 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zaggpon + zaggdon + zaggdon3 156 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zaggpop + zaggdop + zaggdop3 157 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zaggpoc + zaggdoc2 158 tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zaggpon + zaggdon2 159 tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zaggpop + zaggdop2 160 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 161 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 162 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3 163 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zaggdon - zaggdon2 - zaggdon3 164 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zaggdop - zaggdop2 - zaggdop3 165 ! 166 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3 167 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zaggpoc + zaggdoc2 168 ! 169 END DO 170 END DO 171 END DO 144 ! tranfer of DOC to POC due to brownian motion 145 zaggtmp = ( 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) * xstep 146 zaggdoc3 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 147 zaggdon3 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 148 zaggdop3 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 149 150 ! Update the trends 151 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zaggpoc + zaggdoc + zaggdoc3 152 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zaggpon + zaggdon + zaggdon3 153 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zaggpop + zaggdop + zaggdop3 154 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zaggpoc + zaggdoc2 155 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zaggpon + zaggdon2 156 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zaggpop + zaggdop2 157 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zaggfe 158 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zaggfe 159 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zaggdoc - zaggdoc2 - zaggdoc3 160 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zaggdon - zaggdon2 - zaggdon3 161 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zaggdop - zaggdop2 - zaggdop3 162 ! 163 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3 164 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zaggpoc + zaggdoc2 165 ! 166 END_3D 172 167 ! 173 168 ENDIF 174 169 ! 175 IF( ln_ctl) THEN ! print mean trends (used for debugging)170 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 176 171 WRITE(charout, FMT="('agg')") 177 CALL prt_ctl_ trc_info(charout)178 CALL prt_ctl _trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)172 CALL prt_ctl_info( charout, cdcomp = 'top' ) 173 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 179 174 ENDIF 180 175 !
Note: See TracChangeset
for help on using the changeset viewer.
