New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 6810 for branches/NERC – NEMO

Changeset 6810 for branches/NERC


Ignore:
Timestamp:
2016-07-20T14:54:06+02:00 (8 years ago)
Author:
jpalmier
Message:

JPALM -- 20-07-2016 -- adapt dust conversion to SI dust-dep units

-- correct idtra negative values

Location:
branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90

    r6509 r6810  
    133133               DO ji = 2,jpim1 
    134134             
    135                !  IF (trn(ji,jj,jk,jn) > 0.0) THEN 
     135                 IF (trn(ji,jj,jk,jn) > 0.0) THEN 
    136136                    WTEMP = trn(ji,jj,jk,jn) * (1. - FDEC ) 
    137137                    tra(ji,jj,jk,jn) = (tra(ji,jj,jk,jn) - WTEMP/rdt ) * & 
    138138                                     tmask(ji,jj,jk) 
    139                !  ENDIF  
     139                 ELSE 
     140                    trn(ji,jj,jk,jn) = 0.0 
     141                    tra(ji,jj,jk,jn) = 0.0 
     142                 ENDIF  
    140143              ENDDO  
    141144            ENDDO 
  • branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90

    r6715 r6810  
    260260!! 
    261261   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dust      !: dust parameter 1 
     262   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   zirondep  !! Fe deposition 
    262263 
    263264!!---------------------------------------------------------------------- 
     
    488489      !* 2D fields of miscellaneous parameters 
    489490      ALLOCATE( ocal_ccd(jpi,jpj)    , dust(jpi,jpj)        ,       & 
     491         &      zirondep(jpi,jpj)                           ,       & 
    490492         &      riv_n(jpi,jpj)                              ,       & 
    491493         &      riv_si(jpi,jpj)      , riv_c(jpi,jpj)       ,       & 
  • branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90

    r6806 r6810  
    25092509               !! aeolian iron deposition 
    25102510               if (jk.eq.1) then 
    2511                   !! dust   is in g Fe / m2 / month 
    2512                   !! ffetop is in mmol / m3 / day 
    2513                   ffetop  = (((dust(ji,jj) * 1.e3 * xfe_sol) / xfe_mass) / fthk) / 30. 
     2511                  !! zirondep   is in mmol-Fe / m2 / day 
     2512                  !! ffetop     is in mmol-dissolved-Fe / m3 / day 
     2513                  ffetop  = zirondep(ji,jj) * xfe_sol / fthk  
    25142514               else 
    25152515                  ffetop  = 0.0 
  • branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90

    r6744 r6810  
    9898 
    9999      !! AXY (10/02/09) 
    100       REAL(wp), DIMENSION(jpi,jpj)     ::   zsidep    !! Si deposition 
    101       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zirondep  !! Fe deposition 
     100      !! REAL(wp), DIMENSION(jpi,jpj)     ::   zsidep    !! Si deposition 
     101      !! REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zirondep  !! Fe deposition 
    102102      REAL(wp) ::   rfact2 
    103103 
     
    106106      !! JPALM - 26-11-2015 -add iom_use for diagnostic 
    107107       REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d 
     108      !! JPALM -- 20-07-2016 -- 
     109      REAL(wp), PARAMETER :: Fe_dust_mratio = 0.035   !! Fe:dust mass ratio = 0.035 
    108110      !!--------------------------------------------------------------------- 
    109111      !! 
     
    144146      !! AXY (10/02/09) 
    145147      !!IF( (jnt == 1) .and. (bdustfer) )  CALL trc_sed_medusa_sbc( kt ) 
     148 
    146149      !! JPALM -- 31-03-2016 -- rewrite trc_sed_medusa_sbc. 
    147150      !! IF (kt == nittrc000 ) CALL trc_sed_medusa_sbc  
     151 
     152      !! JPALM -- 20-07-2016 -- change the dust dep conversion. 
     153      !!                     now all dust dep forcings and coupling are in SI units :  
     154      !!                     kg-dust/m2/s instead of g-Fe/m2/month. 
     155      !!                     and we convert them here into mmol-Fe/m2/day 
     156      !!                     what will be changed into mmol-Fe/m3/d in trcbio_med 
     157      !! 
    148158      IF( bdustfer ) THEN 
    149159         IF( kt == nittrc000 .OR. ( kt /= nittrc000 .AND. ntimes_dust > 1 ) ) THEN 
     
    157167      ENDIF 
    158168      !! 
    159             
    160       !! 
    161       zirondep(:,:,:) = 0.e0     !! Initialisation of deposition variables 
    162       zsidep  (:,:)   = 0.e0 
    163       !! 
    164       !! Iron and Si deposition at the surface 
     169 
     170      zirondep(:,:) = 0.e0     !! Initialisation of deposition variables 
     171      zirondep(:,:) = dust(:,:) * Fe_dust_mratio / xfe_mass * 1.e6 * 86400  !! mmol-Fe/m2/d 
     172 
     173      !! 
     174      !! JPALM -- 20-07-2016 -- previous Fe and Si deposition. 
     175      !!                     not used --> commented. 
     176      !!                     but may want to use it later on. 
     177      !! 
     178      !! Iron and Si deposition at the surface  
    165179      !! ------------------------------------- 
    166180      !! 
    167       DO jj = 1, jpj 
    168          DO ji = 1, jpi 
    169             zirondep(ji,jj,1) = (dustsolub * dust(ji,jj) / (55.85 * rmtss) + 3.e-10 / ryyss) & 
    170             & * rfact2 / fse3t(ji,jj,1) 
    171             zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * rfact2 / & 
    172             & (fse3t(ji,jj,1) * 28.1 * rmtss) 
    173          END DO 
    174       END DO 
     181      !! DO jj = 1, jpj 
     182      !!    DO ji = 1, jpi 
     183      !!       zirondep(ji,jj,1) = (dustsolub * dust(ji,jj) / (55.85 * rmtss) + 3.e-10 / ryyss) & 
     184      !!       & * rfact2 / fse3t(ji,jj,1) 
     185      !!       zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * rfact2 / & 
     186      !!       & (fse3t(ji,jj,1) * 28.1 * rmtss) 
     187      !!    END DO 
     188      !! END DO 
    175189 
    176190      ! sedimentation of detrital nitrogen : upstream scheme 
Note: See TracChangeset for help on using the changeset viewer.