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 763 for branches/dev_001_GM/NEMO/TOP_SRC/SMS/trcini.lobster1.h90 – NEMO

Ignore:
Timestamp:
2007-12-13T14:52:50+01:00 (16 years ago)
Author:
gm
Message:

dev_001_GM - Style only addition in TOP F90 h90 routines

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/trcini.lobster1.h90

    r719 r763  
     1   !!====================================================================== 
     2   !!                         ***  trcini.lobster1.h90  *** 
     3   !! TOP :   Initialisation of LOBSTER 1 biological model 
     4   !!====================================================================== 
     5   !! History :    -   !  1999-09  (M. Levy) Original code 
     6   !!              -   !  2000-12  (0. Aumont, E. Kestenare) add sediment  
     7   !!             1.0  !  2004-03  (C. Ethe) Modularity 
     8   !!              -   !  2005-03  (O. Aumont, A. El Moussaoui) F90 
    19   !!---------------------------------------------------------------------- 
    2    !!                    ***  trcini.lobster1.h90 *** 
    3    !!---------------------------------------------------------------------- 
     10 
    411#  include "domzgr_substitute.h90" 
    512#  include "passivetrc_substitute.h90" 
     13   !!---------------------------------------------------------------------- 
     14   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     15   !! $Id:$  
     16   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     17   !!---------------------------------------------------------------------- 
     18 
    619CONTAINS 
    720 
    821   SUBROUTINE trc_ini 
    9       !!--------------------------------------------------------------------- 
     22      !!---------------------------------------------------------------------- 
    1023      !!                    ***  ROUTINE trc_ini  *** 
    11       !!  purpose : 
    12       !!  --------- 
    13       !!     specific initialisation for lobster1 model 
    14       !! 
    15       !!   History : 
    16       !!   -------- 
    17       !!      original    : 99-09 (M. Levy)  
    18       !!      additions   : 00-12 (0. Aumont, E. Kestenare) 
    19       !!                           add sediment computations 
    20       !!    03-05 : O. Aumont and A. El Moussaoui F90   
     24      !! ** purpose :   specific initialisation for lobster1 model 
    2125      !!---------------------------------------------------------------------- 
    22       !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    23    !! $Header$  
    24    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     26      INTEGER  ::   ji, jj, jk, jn 
     27      REAL(wp) ::   zdm0(jpi,jpj,jpk), zrro(jpi,jpj), zfluo, zfluu 
     28      REAL(wp) ::   ztest, zfluo, zfluu 
     29      REAL(wp), DIMENSION(jpi,jpj) ::   zrro 
     30      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdm0 
    2531      !!---------------------------------------------------------------------- 
    26       !! local declarations 
    27       !! ================== 
    28       INTEGER ji,jj,jk,jn 
    29       REAL zdm0(jpi,jpj,jpk),zrro(jpi,jpj),zfluo,zfluu 
    30       REAL ztest 
    3132 
    32       !! 1. initialization of fields for optical model 
    33       !! -------------------------------------------- 
     33      ! initialization of fields for optical model 
     34      ! -------------------------------------------- 
     35      xze (:,:)   = 5.e0 
     36      xpar(:,:,:) = 0.e0 
    3437 
    35       xze(:,:)=5. 
    36       xpar(:,:,:)=0. 
     38      ! initialization for passive tracer remineralisation-damping  array 
     39      ! ----------------------------------------------------------------- 
    3740 
    38       !! 2. initialization for passive tracer remineralisation-damping  array 
    39       !! ------------------------------------------------------------------------- 
    40  
    41       DO jn=1,jptra 
    42          remdmp(:,jn)=tminr 
     41      DO jn = 1, jptra 
     42         remdmp(:,jn) = tminr 
    4343      END DO 
    4444 
     
    4949      ENDIF 
    5050 
    51       !! 3. initialization of biological variables 
    52       !! ------------------------------------------ 
     51      ! initialization of biological variables 
     52      ! ------------------------------------------ 
    5353 
    54       !! Calculate vertical distribution of newly formed biogenic poc 
    55       !! in the water column in the case of max. possible bottom depth 
    56       !! ------------------------------------------------------------ 
     54      ! Calculate vertical distribution of newly formed biogenic poc 
     55      ! in the water column in the case of max. possible bottom depth 
     56      ! ------------------------------------------------------------ 
    5757 
    58       zdm0   = 0. 
    59       zrro = 1. 
     58      zdm0   = 0.e0 
     59      zrro = 1.e0 
    6060      DO jk = jpkb,jpkm1 
    6161         DO jj =1, jpj 
    6262            DO ji =1, jpi 
    63                zfluo = (fsdepw(ji,jj,jk)/fsdepw(ji,jj,jpkb))**xhr  
    64                zfluu = (fsdepw(ji,jj,jk+1)/fsdepw(ji,jj,jpkb))**xhr 
    65                IF (zfluo.GT.1.) zfluo = 1. 
    66                zdm0(ji,jj,jk) = zfluo-zfluu 
    67                IF (jk.LE.jpkb-1) zdm0(ji,jj,jk)=0. 
    68                zrro(ji,jj) = zrro(ji,jj)-zdm0(ji,jj,jk) 
    69             ENDDO 
    70          ENDDO 
    71       ENDDO 
    72 !!! 
     63               zfluo = ( fsdepw(ji,jj,jk  ) / fsdepw(ji,jj,jpkb) )**xhr  
     64               zfluu = ( fsdepw(ji,jj,jk+1) / fsdepw(ji,jj,jpkb) )**xhr 
     65               IF( zfluo.GT.1. )   zfluo = 1.e0 
     66               zdm0(ji,jj,jk) = zfluo - zfluu 
     67               IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0.e0 
     68               zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 
     69            END DO 
     70         END DO 
     71      END DO 
    7372 
    7473      zdm0(:,:,jpk) = zrro(:,:) 
    7574 
    76       !! Calculate vertical distribution of newly formed biogenic poc 
    77       !! in the water column with realistic topography (first "dry" layer 
    78       !! contains total fraction, which has passed to the upper layers) 
    79       !! ---------------------------------------------------------------------- 
    80  
     75      ! Calculate vertical distribution of newly formed biogenic poc 
     76      ! in the water column with realistic topography (first "dry" layer 
     77      ! contains total fraction, which has passed to the upper layers) 
     78      ! ---------------------------------------------------------------------- 
    8179      dminl = 0. 
    8280      dmin3 = zdm0 
     81      DO jk = 1, jpk 
     82         DO jj = 1, jpj 
     83            DO ji = 1, jpi 
     84               IF( tmask(ji,jj,jk) == 0. ) THEN 
     85                  dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 
     86                  dmin3(ji,jj,jk) = 0.e0 
     87               ENDIF 
     88            END DO 
     89         END DO 
     90      END DO 
    8391 
    84       DO jk = 1,jpk 
    85          DO jj = 1,jpj 
    86             DO ji = 1,jpi 
     92      DO jj = 1, jpj 
     93         DO ji = 1, jpi 
     94            IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0.e0 
     95         END DO 
     96      END DO 
    8797 
    88                IF(tmask(ji,jj,jk) == 0) THEN 
    89                   dminl(ji,jj) = dminl(ji,jj)+dmin3(ji,jj,jk) 
    90                   dmin3(ji,jj,jk) = 0.0 
    91                ENDIF 
    92  
    93             ENDDO 
    94          ENDDO 
    95       ENDDO 
    96  
    97       DO jj = 1,jpj 
    98          DO ji = 1,jpi 
    99             IF (tmask(ji,jj,1) == 0) dmin3(ji,jj,1) = 0. 
    100          ENDDO 
    101       ENDDO 
    102  
    103       !! CALCUL DU MASK DE COTE 
    104       !! ----------------------    
    105       cmask=0. 
    106       do ji=2,jpi-1 
    107          do jj=2,jpj-1 
     98      ! Coastal mask  
     99      ! ------------    
     100      cmask = 0.e0 
     101      DO ji = 2, jpi-1 
     102         DO jj = 2, jpj-1 
    108103            if (tmask(ji,jj,1) == 1) then 
    109104               ztest=tmask(ji+1,jj,1)*tmask(ji-1,jj,1)*tmask(ji,jj+1,1)*tmask(ji,jj-1,1) 
    110105               IF (ztest == 0) cmask(ji,jj) = 1. 
    111106            endif 
    112          end do 
    113       end do 
     107         END DO 
     108      END DO 
    114109 
    115       cmask(1,:)=cmask(jpi-1,:) 
    116       cmask(jpi,:)=cmask(2,:) 
     110      cmask( 1 ,:) = cmask(jpi-1,:) 
     111      cmask(jpi,:) = cmask( 2   ,:) 
    117112 
     113      !!gm BUG !!!!!   not valid in mpp and also not valid for north fold   !!!!! 
    118114 
    119       !! CALCUL DE LA SURFACE COTIERE 
    120       !! ---------------------------- 
    121       areacot=0. 
    122       do ji=2,jpi-1 
    123          do jj=2,jpj-1 
    124             areacot=areacot+e1t(ji,jj)*e2t(ji,jj)*cmask(ji,jj) 
    125          end do 
    126       end do 
    127  
     115      ! Coastal surface 
     116      ! --------------- 
     117      areacot = 0.e0 
     118      DO ji = 2, jpi-1 
     119         DO jj = 2, jpj-1 
     120            areacot = areacot + e1t(ji,jj) * e2t(ji,jj) * cmask(ji,jj) 
     121         END DO 
     122      END DO 
     123      ! 
    128124   END SUBROUTINE trc_ini 
Note: See TracChangeset for help on using the changeset viewer.