- Timestamp:
- 2017-01-25T16:37:31+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r6943 r7607 23 23 USE sms_pisces ! PISCES Source Minus Sink variables 24 24 USE prtctl_trc ! print control for debugging 25 USE p4zche ! Chemical model 25 26 USE iom ! I/O manager 26 27 … … 60 61 ! 61 62 INTEGER, INTENT(in) :: kt, knt ! ocean time step 62 INTEGER :: ji, jj, jk, jn 63 REAL(wp) :: zalk, zdic, zph, zah2 64 REAL(wp) :: zdispot, zfact, zcalcon, zalka, zaldi 63 INTEGER :: ji, jj, jk 64 REAL(wp) :: zdispot, zfact, zcalcon 65 65 REAL(wp) :: zomegaca, zexcess, zexcess0 66 66 CHARACTER (len=25) :: charout 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zco3sat, zcaldiss 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zco3sat, zcaldiss, zhinit, zhi 68 68 !!--------------------------------------------------------------------- 69 69 ! 70 70 IF( nn_timing == 1 ) CALL timing_start('p4z_lys') 71 71 ! 72 CALL wrk_alloc( jpi, jpj, jpk, zco3, zco3sat, zcaldiss )72 CALL wrk_alloc( jpi, jpj, jpk, zco3, zco3sat, zcaldiss, zhinit, zhi ) 73 73 ! 74 74 zco3 (:,:,:) = 0. 75 75 zcaldiss(:,:,:) = 0. 76 zhinit(:,:,:) = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn ) 76 77 ! ------------------------------------------- 77 78 ! COMPUTE [CO3--] and [H+] CONCENTRATIONS 78 79 ! ------------------------------------------- 79 80 DO jn = 1, 5 ! BEGIN OF ITERATION 81 ! 82 !CDIR NOVERRCHK 83 DO jk = 1, jpkm1 84 !CDIR NOVERRCHK 85 DO jj = 1, jpj 86 !CDIR NOVERRCHK 87 DO ji = 1, jpi 88 zfact = rhop(ji,jj,jk) / 1000. + rtrn 89 zph = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+] 90 zdic = trb(ji,jj,jk,jpdic) / zfact 91 zalka = trb(ji,jj,jk,jptal) / zfact 92 ! CALCULATE [ALK]([CO3--], [HCO3-]) 93 zalk = zalka - ( akw3(ji,jj,jk) / zph - zph / ( aphscale(ji,jj,jk) + rtrn ) & 94 & + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) ) 95 ! CALCULATE [H+] and [CO3--] 96 zaldi = zdic - zalk 97 zah2 = SQRT( zaldi * zaldi + 4.* ( zalk * ak23(ji,jj,jk) / ak13(ji,jj,jk) ) * ( zdic + zaldi ) ) 98 zah2 = 0.5 * ak13(ji,jj,jk) / zalk * ( zaldi + zah2 ) 99 ! 100 zco3(ji,jj,jk) = zalk / ( 2. + zah2 / ak23(ji,jj,jk) ) * zfact 101 hi(ji,jj,jk) = zah2 * zfact 102 END DO 80 81 CALL p4z_che_solve_hi( zhinit, zhi ) 82 83 DO jk = 1, jpkm1 84 DO jj = 1, jpj 85 DO ji = 1, jpi 86 zco3(ji,jj,jk) = trb(ji,jj,jk,jpdic) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2 & 87 & + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 88 hi(ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. 103 89 END DO 104 90 END DO 105 ! 106 END DO 91 END DO 107 92 108 93 ! --------------------------------------------------------- … … 138 123 ! AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 139 124 zcaldiss(ji,jj,jk) = zdispot * rfact2 / rmtss ! calcite dissolution 140 zco3(ji,jj,jk) = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk)141 125 ! 142 126 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk) … … 167 151 ENDIF 168 152 ! 169 CALL wrk_dealloc( jpi, jpj, jpk, zco3, zc o3sat, zcaldiss)153 CALL wrk_dealloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat ) 170 154 ! 171 155 IF( nn_timing == 1 ) CALL timing_stop('p4z_lys') … … 186 170 !! 187 171 !!---------------------------------------------------------------------- 188 INTEGER :: ji, jj, jk189 172 INTEGER :: ios ! Local integer output status for namelist read 190 REAL(wp) :: zcaralk, zbicarb, zco3191 REAL(wp) :: ztmas, ztmas1192 193 173 NAMELIST/nampiscal/ kdca, nca 194 174 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.