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 777 for branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcsed.F90 – NEMO

Ignore:
Timestamp:
2007-12-19T19:40:57+01:00 (16 years ago)
Author:
gm
Message:

dev_001_GM - LOBSTER in F90 encapsulation of LOBSTER routines in module - compilation OK

File:
1 moved

Legend:

Unmodified
Added
Removed
  • branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcsed.F90

    r774 r777  
    1 CC $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcsed.F,v 1.7 2007/10/12 09:36:28 opalod Exp $ 
    2 CDIR$ LIST 
    3       SUBROUTINE trcsed(kt) 
    4 CCC--------------------------------------------------------------------- 
    5 CCC 
    6 CCC                       ROUTINE trcsed 
    7 CCC                     ******************* 
    8 CCC 
    9 CCC  PURPOSE : 
    10 CCC  --------- 
    11 CCC     compute the now trend due to the vertical sedimentation of 
    12 CCC     detritus and add it to the general trend of detritus equations. 
    13 CCC 
    14 CCC 
    15 CC   METHOD : 
    16 CC   ------- 
    17 CC      this ROUTINE compute not exactly the advection but the 
    18 CC      transport term, i.e.  dz(wt) and dz(ws)., dz(wtr) 
    19 CC      using an upstream scheme 
    20 CC 
    21 CC the now vertical advection of tracers is given by: 
    22 CC 
    23 CC       dz(trn wn) = 1/bt dk+1( e1t e2t vsed (trn) ) 
    24 CC 
    25 CC add this trend now to the general trend of tracer (ta,sa,tra): 
    26 CC 
    27 CC                     tra = tra + dz(trn wn) 
    28 CC 
    29 CC      IF 'key_trc_diabio' key is activated, the now vertical advection 
    30 CC      trend of passive tracers is saved for futher diagnostics. 
    31 CC 
    32 CC multitasked on vertical slab (jj-loop) 
    33 CC 
    34 CC 
    35 CC   INPUT : 
    36 CC   ----- 
    37 CC      argument 
    38 CC              ktask           : task identificator 
    39 CC              kt              : time step 
    40 CC      COMMON 
    41 CC            /comcoo/          : orthogonal curvilinear coordinates 
    42 CC                                and scale factors 
    43 CC            /cottrp/          : passive tracer fields 
    44 CC            /comtsk/          : multitasking 
    45 CC 
    46 CC   OUTPUT : 
    47 CC   ------ 
    48 CC      COMMON 
    49 CC            /cottrp/tra       : general tracer trend increased by the 
    50 CC            now vertical tracer advection trend 
    51 CC            /cottbd/ trbio    : now vertical passive tracer advection 
    52 CC                                trend 
    53 CC                                (IF 'key_trc_diabio' key is activated) 
    54 CC 
    55 CC   WORKSPACE : 
    56 CC   --------- 
    57 CC local 
    58 CC    ze1e2w, ze3tr, ztra 
    59 CC      COMMON 
    60 CC 
    61 CC   EXTERNAL :                   no 
    62 CC   -------- 
    63 CC 
    64 CC   REFERENCES :                 no 
    65 CC   ---------- 
    66 CC 
    67 CC   MODIFICATIONS: 
    68 CC   -------------- 
    69 CC       original : 95-06 (M. Levy) 
    70 CC       additions: 00-12 (E. Kestenare): clean up  
    71 CC---------------------------------------------------------------------- 
    72 CDIR$ NOLIST 
    73       USE oce_trc 
    74       USE trp_trc 
    75       USE sms 
    76       USE lbclnk 
    77       IMPLICIT NONE 
    78 CDIR$ LIST 
    79 CC---------------------------------------------------------------------- 
    80 CC local declarations 
    81 CC ================== 
    82       INTEGER kt 
     1MODULE trcsed 
     2   !!====================================================================== 
     3   !!                         ***  MODULE p4sed  *** 
     4   !! TOP :   PISCES Compute loss of organic matter in the sediments 
     5   !!====================================================================== 
     6   !! History :    -   !  1995-06 (M. Levy)  original code 
     7   !!              -   !  2000-12 (E. Kestenare)  clean up 
     8   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90 + simplifications 
     9   !!---------------------------------------------------------------------- 
     10#if defined key_lobster 
     11   !!---------------------------------------------------------------------- 
     12   !!   'key_lobster'                                     LOBSTER bio-model 
     13   !!---------------------------------------------------------------------- 
     14   !!   trc_sed        :  Compute loss of organic matter in the sediments 
     15   !!---------------------------------------------------------------------- 
     16   USE oce_trc         ! 
     17   USE trp_trc 
     18   USE sms 
     19   USE lbclnk 
    8320 
    84 #if defined key_top && defined key_lobster 
     21   IMPLICIT NONE 
     22   PRIVATE 
    8523 
    86       INTEGER ji,jj,jk 
    87       REAL ze3tr,ztra 
    88       REAL zwork(jpi,jpk) 
    89 #if defined key_trc_diaadd 
    90       REAL ze3t(jpi,jpj,jpk) 
    91 #endif 
    92 CC---------------------------------------------------------------------- 
    93 CC statement functions 
    94 CC =================== 
    95 CDIR$ NOLIST 
    96 #include "domzgr_substitute.h90" 
    97 CDIR$ LIST 
    98 CCC--------------------------------------------------------------------- 
    99 CCC  OPA8, LODYC (15/11/96) 
    100 CCC--------------------------------------------------------------------- 
    101 C 
    102 #if defined key_trc_diaadd 
    103 C convert fluxes in per day 
    104       ze3t(:,:,:) = 0. 
    105       DO jk=1,jpkbm1 
    106         DO jj = 2, jpjm1 
    107           DO ji = 2, jpim1 
    108             ze3t(ji,jj,jk)=fse3t(ji,jj,jk)*86400. 
    109           END DO 
    110         END DO 
    111       END DO  
    112 #endif 
     24   PUBLIC   trc_sed    ! called in ??? 
    11325 
    114 C 
    115 C vertical slab 
    116 C ============= 
    117 C 
    118       DO 1000 jj = 1,jpj 
     26   !!* Substitution 
     27#  include "domzgr_substitute.h90" 
     28   !!---------------------------------------------------------------------- 
     29   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     30   !! $Id:$  
     31   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     32   !!---------------------------------------------------------------------- 
    11933 
    120 C 
    121 C 
    122 C 1. sedimentation of detritus  : upstream scheme 
    123 C ----------------------------------------------- 
    124 C 
    125 C 
    126 C for detritus sedimentation only - jpdet 
    127 C 
    128 C 1.1 initialisation needed for bottom and surface value 
    129 C 
    130               DO jk=1,jpk 
    131                 DO  ji = 1,jpi 
    132                   zwork(ji,jk) = 0. 
    133                 END DO  
    134               END DO 
    135 C 
    136 C 1.2 tracer flux at w-point: we use -vsed (downward flux) 
    137 C with simplification : no e1*e2 
    138 C 
    139               DO  jk = 2,jpk 
    140                 DO  ji = 1,jpi 
    141                   zwork(ji,jk) = -vsed * trn(ji,jj,jk - 1,jpdet) 
    142                 END DO 
    143               END DO 
    144 C 
    145 C 1.3 tracer flux divergence at t-point added to the general trend 
    146 C 
    147               DO  jk = 1,jpkm1 
    148                 DO  ji = 1,jpi 
    149                   ze3tr = 1./fse3t(ji,jj,jk) 
    150                   ztra = -ze3tr * (zwork(ji,jk) - zwork(ji,jk + 1)) 
    151                   tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra 
    152 #            if defined key_trc_diabio 
    153                   trbio(ji,jj,jk,8) = ztra 
    154 #            endif 
    155 #if defined key_trc_diaadd 
    156             trc2d(ji,jj,8)=trc2d(ji,jj,8)+ztra*ze3t(ji,jj,jk) 
    157 #endif 
    158                 END DO 
    159               END DO 
    160 C 
    161 C END of slab 
    162 C =========== 
     34CONTAINS 
    16335 
    164  1000 CONTINUE 
    165 C 
     36   SUBROUTINE trc_sed( kt ) 
     37      !!--------------------------------------------------------------------- 
     38      !!                     ***  ROUTINE trc_sed  *** 
     39      !! 
     40      !! ** Purpose :   compute the now trend due to the vertical sedimentation of 
     41      !!              detritus and add it to the general trend of detritus equations 
     42      !! 
     43      !! ** Method  :   this ROUTINE compute not exactly the advection but the 
     44      !!              transport term, i.e.  dz(wt) and dz(ws)., dz(wtr) 
     45      !!              using an upstream scheme 
     46      !!              the now vertical advection of tracers is given by: 
     47      !!                      dz(trn wn) = 1/bt dk+1( e1t e2t vsed (trn) ) 
     48      !!              add this trend now to the general trend of tracer (ta,sa,tra): 
     49      !!                             tra = tra + dz(trn wn) 
     50      !!         
     51      !!              IF 'key_trc_diabio' is defined, the now vertical advection 
     52      !!              trend of passive tracers is saved for futher diagnostics. 
     53      !!--------------------------------------------------------------------- 
     54      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     55      !! 
     56      INTEGER  ::   ji, jj, jk 
     57      REAL(wp) ::   ztra 
     58      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwork 
     59      !!--------------------------------------------------------------------- 
     60 
     61      IF( kt == nit000 ) THEN 
     62         IF(lwp) WRITE(numout,*) 
     63         IF(lwp) WRITE(numout,*) ' trc_sed: LOBSTER sedimentation' 
     64         IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
     65      ENDIF 
     66 
     67      ! sedimentation of detritus  : upstream scheme 
     68      ! -------------------------------------------- 
     69 
     70      ! for detritus sedimentation only - jpdet 
     71 
     72      zwork(:,:,1  ) = 0.e0      ! surface value set to zero 
     73      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero 
     74 
     75      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2 
     76 
     77      DO jk = 2, jpkm1 
     78         zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jpdet) 
     79      END DO 
     80 
     81      ! tracer flux divergence at t-point added to the general trend 
     82 
     83      DO jk = 1, jpkm1 
     84         DO jj = 1, jpj 
     85            DO ji = 1,jpi 
     86               ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
     87               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra 
     88# if defined key_trc_diabio 
     89               trbio(ji,jj,jk,8) = ztra 
     90# endif 
     91# if defined key_trc_diaadd 
     92               trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400. 
     93# endif 
     94            END DO 
     95         END DO 
     96      END DO 
     97 
    16698#if defined key_trc_diabio 
    167 C Lateral boundary conditions on trcbio 
    168       CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. ) 
     99      CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. )    ! Lateral boundary conditions on trcbio 
    169100#endif 
    170101#if defined key_trc_diaadd 
    171 C Lateral boundary conditions on trc2d 
    172       CALL lbc_lnk (trc2d(:,:,8), 'T', 1. ) 
     102      CALL lbc_lnk( trc2d(:,:,8), 'T', 1. )      ! Lateral boundary conditions on trc2d 
    173103#endif 
    174 C 
     104      ! 
     105   END SUBROUTINE trc_sed 
    175106 
    176107#else 
    177 C 
    178 C     no passive tracer 
    179 C 
    180 #endif 
    181 C 
    182       RETURN 
    183       END 
     108   !!====================================================================== 
     109   !!  Dummy module :                                   No PISCES bio-model 
     110   !!====================================================================== 
     111CONTAINS 
     112   SUBROUTINE trc_sed( kt )                   ! Empty routine 
     113      INTEGER, INTENT( in ) ::   kt 
     114      WRITE(*,*) 'trc_sed: You should not have seen this print! error?', kt 
     115   END SUBROUTINE trc_sed 
     116#endif  
     117 
     118   !!====================================================================== 
     119END MODULE  trcsed 
Note: See TracChangeset for help on using the changeset viewer.