Changeset 8039 for branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/detritus_fast_sink.F90

Timestamp:

2017-05-18T11:14:31+02:00 (7 years ago)

Author:

marc

Message:

Removed about 40 2d arrays from bio_medusa_mod.F90

File:

• branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/detritus_fast_sink.F90 (modified) (17 diffs)

branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/detritus_fast_sink.F90

@@ -35 +35 @@
                                    f_benout_si,                            &
                                    f_fbenin_c, f_fbenin_ca, f_fbenin_fe,   &
-                                   f_fbenin_n, f_fbenin_si,                &
-                                   f_omcal, fcaco3,                        &
-                                   fccd, fccd_dep, fdep1, fdd,             &
+                                   f_fbenin_n, f_fbenin_si, f_omcal,       &
+                                   fccd, fdep1, fdd,                       &
                                    fdpd, fdpd2, fdpds, fdpds2,             &
                                    fdpn, fdpn2,                            &
@@ -52 +51 @@
                                    fmeexcr, fmiexcr,                       &
                                    fofd_fe, fofd_n, fofd_si,               &
-                                   fprotf,                                 &
                                    fregen, fregenfast, fregenfastsi,       &
                                    fregensi,                               &
@@ -73 +71 @@
       USE oce,               ONLY: tsn
       USE par_kind,          ONLY: wp
-      USE par_oce,           ONLY: jpim1, jpjm1
+      USE par_oce,           ONLY: jpi, jpim1, jpj, jpjm1
       USE sms_medusa,        ONLY: f2_ccd_cal, f3_omcal,                   &
                                    jexport, jfdfate, jinorgben, jocalccd,  &
@@ -102 +100 @@
       INTEGER :: ji, jj
 
-      REAL(wp) ::    fb_val, fl_sst
+      REAL(wp) :: fb_val, fl_sst
+      !! Particle flux
+      REAL(wp) :: fcaco3
+      REAL(wp) :: fprotf
+      REAL(wp), DIMENSION(jpi,jpj) :: fccd_dep
       !! temporary variables
       REAL(wp) :: fq0,fq1,fq2,fq3,fq4,fq5,fq6,fq7,fq8
@@ -236 +238 @@
                   !!             primary production
                   !!               0.10 at equator; 0.02 at pole
-                  fcaco3(ji,jj) = xcaco3a + ((xcaco3b - xcaco3a) *           &
-                                             ((90.0 - abs(gphit(ji,jj))) /   &
-                                               90.0))
+                  fcaco3 = xcaco3a + ((xcaco3b - xcaco3a) *                  &
+                                      ((90.0 - abs(gphit(ji,jj))) / 90.0))
                elseif (jrratio.eq.1) then
                   !! CaCO3:      Ridgwell et al. (2007) submodel, version 1
@@ -248 +249 @@
                      fq1 = 0.
                   endif
-                  fcaco3(ji,jj) = xridg_r0 * fq1
+                  fcaco3 = xridg_r0 * fq1
                elseif (jrratio.eq.2) then
                   !! CaCO3:      Ridgwell et al. (2007) submodel, version 2
@@ -258 +259 @@
                      fq1 = 0.
                   endif
-                  fcaco3(ji,jj) = xridg_r0 * fq1
+                  fcaco3 = xridg_r0 * fq1
                endif
-            ENDIF
-         ENDDO
-      ENDDO
 # else
-      DO jj = 2,jpjm1
-         DO ji = 2,jpim1
-            if (tmask(ji,jj,jk) == 1) then
                !! CaCO3:      latitudinally-based fraction of total primary
                !!              production
                !!               0.10 at equator; 0.02 at pole
-               fcaco3(ji,jj) = xcaco3a + ((xcaco3b - xcaco3a) *              &
-                                          ((90.0 - abs(gphit(ji,jj))) / 90.0))
-            ENDIF
-         ENDDO
-      ENDDO
+               fcaco3 = xcaco3a + ((xcaco3b - xcaco3a) *                      &
+                                   ((90.0 - abs(gphit(ji,jj))) / 90.0))
 # endif
-
-      DO jj = 2,jpjm1
-         DO ji = 2,jpim1
-            if (tmask(ji,jj,jk) == 1) then
                !! AXY (09/03/09): convert CaCO3 production from function of 
                !! primary production into a function of fast-sinking material; 
@@ -286 +274 @@
                !! chlorophyll to an export flux for which they apply conversion 
                !! factors to estimate the various elemental fractions (Si, Ca)
-               ftempca(ji,jj) = ftempc(ji,jj) * fcaco3(ji,jj)
+               ftempca(ji,jj) = ftempc(ji,jj) * fcaco3
 
 # if defined key_debug_medusa
@@ -316 +304 @@
                   IF (lwp) write (numout,*) 'flat(',jk,')    = ',             &
                                             abs(gphit(ji,jj))
-                  IF (lwp) write (numout,*) 'fcaco3(',jk,')  = ', fcaco3(ji,jj)
+                  IF (lwp) write (numout,*) 'fcaco3(',jk,')  = ', fcaco3
                endif
 # endif
@@ -428 +416 @@
                         if (fq4.lt.fq1) then
                            !! protected fraction of total organic C (non-dim)
-                           fprotf(ji,jj)   = (fq4 / (fq1 + tiny(fq1)))
+                           fprotf   = (fq4 / (fq1 + tiny(fq1)))
                         else
                            !! all organic C is protected (non-dim)
-                           fprotf(ji,jj)   = 1.0
+                           fprotf   = 1.0
                         endif
                         !! unprotected fraction of total organic C (non-dim)
-                        fq5      = (1.0 - fprotf(ji,jj))
+                        fq5      = (1.0 - fprotf)
                         !! how much organic C is unprotected (mol)
                         fq6      = (fq0 * fq5)
@@ -440 +428 @@
                         fq7      = (fq6 * exp(-(fse3t(ji,jj,jk) / xfastc)))
                         !! how much total C leaves this box (mol)
-                        fq8      = (fq7 + (fq0 * fprotf(ji,jj)))
+                        fq8      = (fq7 + (fq0 * fprotf))
                         !! C remineralisation in this box (mol)
                         freminc(ji,jj)  = (fq0 - fq8) / fse3t(ji,jj,jk)
@@ -454 +442 @@
                                        fq4
                               IF (lwp) write (numout,*) 'fprotf(',jk,')  = ', &
-                                       fprotf(ji,jj)
+                                       fprotf
                               IF (lwp) write (numout,*)                       &
                                        '------------------------------'
@@ -480 +468 @@
                      if (iball.eq.1) then
                         !! unprotected fraction of total organic N (non-dim)
-                        fq5      = (1.0 - fprotf(ji,jj))
+                        fq5      = (1.0 - fprotf)
                         !! how much organic N is unprotected (mol)
                         fq6      = (fq0 * fq5)
@@ -486 +474 @@
                         fq7      = (fq6 * exp(-(fse3t(ji,jj,jk) / xfastc)))
                         !! how much total N leaves this box (mol)
-                        fq8      = (fq7 + (fq0 * fprotf(ji,jj)))
+                        fq8      = (fq7 + (fq0 * fprotf))
                         !! N remineralisation in this box (mol)
                         freminn(ji,jj)  = (fq0 - fq8) / fse3t(ji,jj,jk)
@@ -498 +486 @@
                            IF (lwp) write (numout,*) 'prtctN(',jk,')  = ', fq4
                            IF (lwp) write (numout,*) 'fprotf(',jk,')  = ',    &
-                                    fprotf(ji,jj)
+                                    fprotf
                            IF (lwp) write (numout,*)                          &
                                     '------------------------------'
@@ -525 +513 @@
                      if (iball.eq.1) then
                         !! unprotected fraction of total organic Fe (non-dim)
-                        fq5      = (1.0 - fprotf(ji,jj))
+                        fq5      = (1.0 - fprotf)
                         !! how much organic Fe is unprotected (mol)
                         fq6      = (fq0 * fq5)
@@ -531 +519 @@
                         fq7      = (fq6 * exp(-(fse3t(ji,jj,jk) / xfastc)))
                         !! how much total Fe leaves this box (mol)
-                        fq8      = (fq7 + (fq0 * fprotf(ji,jj)))
+                        fq8      = (fq7 + (fq0 * fprotf))
                         !! Fe remineralisation in this box (mol)
                         freminfe(ji,jj) = (fq0 - fq8) / fse3t(ji,jj,jk)