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 703 – NEMO

Changeset 703


Ignore:
Timestamp:
2007-10-10T10:14:32+02:00 (16 years ago)
Author:
smasson
Message:

code modifications associated with the new routines, see ticket:4

Location:
trunk/NEMO/OPA_SRC
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/DOM/closea.F90

    r699 r703  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  closea  *** 
    4    !! Closed Seas  :  
     4   !! Closed Seas  : specific treatments associated with closed seas 
    55   !!====================================================================== 
     6   !! History :   8.2  !  00-05  (O. Marti)  Original code 
     7   !!             8.5  !  02-06  (E. Durand, G. Madec)  F90 
     8   !!             9.0  !  06-07  (G. Madec)  add clo_rnf, clo_ups, clo_bat 
     9   !!---------------------------------------------------------------------- 
    610 
    711   !!---------------------------------------------------------------------- 
    812   !!   dom_clo    : modification of the ocean domain for closed seas cases 
    9    !!   flx_clo    : Special handling of closed seas 
    10    !!---------------------------------------------------------------------- 
    11    !! * Modules used 
     13   !!   sbc_clo    : Special handling of closed seas 
     14   !!   clo_rnf    : set close sea outflows as river mouths (see sbcrnf) 
     15   !!   clo_ups    : set mixed centered/upstream scheme in closed sea (see traadv_cen2) 
     16   !!   clo_bat    : set to zero a field over closed sea (see domzrg) 
     17   !!---------------------------------------------------------------------- 
    1218   USE oce             ! dynamics and tracers 
    1319   USE dom_oce         ! ocean space and time domain 
    1420   USE in_out_manager  ! I/O manager 
    15    USE ocesbc          ! ocean surface boundary conditions (fluxes) 
    16    USE flxrnf          ! runoffs 
     21   USE sbc_oce         ! ocean surface boundary conditions 
    1722   USE lib_mpp         ! distributed memory computing library 
    1823   USE lbclnk          ! ??? 
     
    2126   PRIVATE 
    2227 
    23    !! * Accessibility 
    24    PUBLIC dom_clo      ! routine called by dom_init 
    25    PUBLIC flx_clo      ! routine called by step 
    26  
    27    !! * Share module variables 
    28    INTEGER, PUBLIC, PARAMETER ::   &  !: 
    29       jpncs   = 4               !: number of closed sea 
    30    INTEGER, PUBLIC ::          & !!: namclo : closed seas and lakes 
    31       nclosea =  0                !: = 0 no closed sea or lake 
    32       !                           !  = 1 closed sea or lake in the domain 
    33    INTEGER, PUBLIC, DIMENSION (jpncs) ::   &  !: 
    34       ncstt,           &  !: Type of closed sea 
    35       ncsi1, ncsj1,    &  !: closed sea limits                                                                  
    36       ncsi2, ncsj2,    &  !:  
    37       ncsnr               !: number of point where run-off pours 
    38    INTEGER, PUBLIC, DIMENSION (jpncs,4) ::   & 
    39       ncsir, ncsjr        !: Location of run-off 
    40  
    41    !! * Module variable 
    42    REAL(wp), DIMENSION (jpncs+1) ::   & 
    43       surf               ! closed sea surface 
     28   PUBLIC dom_clo      ! routine called by domain module 
     29   PUBLIC sbc_clo      ! routine called by step module 
     30   PUBLIC clo_rnf      ! routine called by sbcrnf module 
     31   PUBLIC clo_ups      ! routine called in traadv_cen2(_jki) module 
     32   PUBLIC clo_bat      ! routine called in domzgr module 
     33 
     34   !!* Namelist namclo : closed seas and lakes 
     35   INTEGER, PUBLIC                     ::   nclosea =  0     !: = 0 no closed sea or lake 
     36      !                                                      !  = 1 closed sea or lake in the domain 
     37       
     38   INTEGER, PUBLIC, PARAMETER          ::   jpncs   = 4      !: number of closed sea 
     39   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncstt            !: Type of closed sea 
     40   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi1, ncsj1     !: south-west closed sea limits (i,j) 
     41   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi2, ncsj2     !: north-east closed sea limits (i,j) 
     42   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsnr            !: number of point where run-off pours 
     43   INTEGER, PUBLIC, DIMENSION(jpncs,4) ::   ncsir, ncsjr     !: Location of runoff 
     44 
     45   REAL(wp), DIMENSION (jpncs+1)       ::   surf             ! closed sea surface 
    4446 
    4547   !! * Substitutions 
    4648#  include "vectopt_loop_substitute.h90" 
    4749   !!---------------------------------------------------------------------- 
    48    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     50   !!  OPA 9.0 , LOCEAN-IPSL (2006)  
    4951   !! $Id$ 
    50    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     52   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5153   !!---------------------------------------------------------------------- 
    5254 
     
    6062      !! 
    6163      !! ** Method  :   if a closed sea is located only in a model grid point 
    62       !!      just the thermodynamic processes are applied. 
    63       !! 
    64       !! ** Action :   ncsi1(), ncsj1() : south-west closed sea limits (i,j) 
    65       !!               ncsi2(), ncsj2() : north-east Closed sea limits (i,j) 
    66       !!               ncsir(), ncsjr() : Location of runoff 
    67       !!               ncsnr            : number of point where run-off pours 
    68       !!               ncstt            : Type of closed sea 
    69       !!                                  =0 spread over the world ocean 
    70       !!                                  =2 put at location runoff 
    71       !! 
    72       !! History : 
    73       !!        !  01-04  (E. Durand)  Original code 
    74       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    75       !!---------------------------------------------------------------------- 
    76       !! * Local variables 
     64      !!                just the thermodynamic processes are applied. 
     65      !! 
     66      !! ** Action  :   ncsi1(), ncsj1() : south-west closed sea limits (i,j) 
     67      !!                ncsi2(), ncsj2() : north-east Closed sea limits (i,j) 
     68      !!                ncsir(), ncsjr() : Location of runoff 
     69      !!                ncsnr            : number of point where run-off pours 
     70      !!                ncstt            : Type of closed sea 
     71      !!                                   =0 spread over the world ocean 
     72      !!                                   =2 put at location runoff 
     73      !!---------------------------------------------------------------------- 
    7774      INTEGER ::   jc            ! dummy loop indices 
    7875      !!---------------------------------------------------------------------- 
     
    9087 
    9188      IF( cp_cfg == "orca" ) THEN 
    92     
     89         ! 
    9390         SELECT CASE ( jp_cfg ) 
    9491         !                                           ! ======================= 
    9592         CASE ( 2 )                                  !  ORCA_R2 configuration 
    9693            !                                        ! ======================= 
    97  
    9894            !                                            ! Caspian Sea 
    9995            ncsnr(1)   =   1  ;  ncstt(1)   =   0           ! spread over the globe 
     
    116112            ncsi2(4)   =   6  ;  ncsj2(4)   = 112 
    117113            ncsir(4,1) = 171  ;  ncsjr(4,1) = 106  
    118  
    119114            !                                        ! ======================= 
    120115         CASE ( 4 )                                  !  ORCA_R4 configuration 
    121116            !                                        ! ======================= 
    122  
    123117            !                                            ! Caspian Sea 
    124118            ncsnr(1)   =  1  ;  ncstt(1)   =  0   
     
    144138            ncsi2(4)   = 76  ;  ncsj2(4)   = 61 
    145139            ncsir(4,1) = 84  ;  ncsjr(4,1) = 59  
    146  
    147140            !                                        ! ======================= 
    148141         CASE ( 025 )                                ! ORCA_R025 configuration 
     
    157150            ncsi2(2)   = 1304 ; ncsj2(2)   = 747 
    158151            ncsir(2,1) = 1    ; ncsjr(2,1) = 1 
    159  
     152            ! 
    160153         END SELECT 
    161  
     154         ! 
    162155      ENDIF 
    163156 
     
    171164         ncsj2(jc)   = mj1( ncsj2(jc) )   
    172165      END DO 
    173           
    174  
     166      ! 
    175167   END SUBROUTINE dom_clo 
    176168 
    177169 
    178    SUBROUTINE flx_clo( kt ) 
    179       !!--------------------------------------------------------------------- 
    180       !!                  ***  ROUTINE flx_clo  *** 
     170   SUBROUTINE sbc_clo( kt ) 
     171      !!--------------------------------------------------------------------- 
     172      !!                  ***  ROUTINE sbc_clo  *** 
    181173      !!                     
    182174      !! ** Purpose :   Special handling of closed seas 
     
    186178      !!      put as run-off in open ocean. 
    187179      !! 
    188       !! ** Action : 
    189       !! 
    190       !! History : 
    191       !!   8.2  !  00-05  (O. Marti)  Original code 
    192       !!   8.5  !  02-07  (G. Madec)  Free form, F90 
    193       !!---------------------------------------------------------------------- 
    194       !! * Arguments 
    195       INTEGER, INTENT (in) :: kt 
    196  
    197       !! * Local declarations 
    198       REAL(wp), DIMENSION (jpncs) :: zemp 
    199       INTEGER  :: ji, jj, jc, jn 
    200       REAL(wp) :: zze2 
    201       !!---------------------------------------------------------------------- 
    202  
    203       ! 1 - Initialisation 
    204       ! ------------------ 
    205  
    206       IF( kt == nit000 ) THEN  
     180      !! ** Action  :   emp, emps   updated surface freshwater fluxes at kt 
     181      !!---------------------------------------------------------------------- 
     182      INTEGER, INTENT(in) ::   kt   ! ocean model time step 
     183      ! 
     184      INTEGER                     ::   ji, jj, jc, jn   ! dummy loop indices 
     185      REAL(wp)                    ::   zze2 
     186      REAL(wp), DIMENSION (jpncs) ::   zemp 
     187      !!---------------------------------------------------------------------- 
     188      ! 
     189      !                                                   !------------------! 
     190      IF( kt == nit000 ) THEN                             !  Initialisation  ! 
     191         !                                                !------------------! 
    207192         IF(lwp) WRITE(numout,*) 
    208          IF(lwp) WRITE(numout,*)'flx_clo : closed seas ' 
     193         IF(lwp) WRITE(numout,*)'sbc_clo : closed seas ' 
    209194         IF(lwp) WRITE(numout,*)'~~~~~~~' 
    210195 
     
    216201            DO jj = ncsj1(jc), ncsj2(jc) 
    217202               DO ji = ncsi1(jc), ncsi2(jc) 
    218                   ! surface of closed seas 
    219                   surf(jc) = surf(jc) + e1t(ji,jj)*e2t(ji,jj)*tmask_i(ji,jj) 
    220                   ! upstream in closed seas 
    221                   upsadv(ji,jj) = 0.5 
     203                  surf(jc) = surf(jc) + e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)      ! surface of closed seas 
    222204               END DO  
    223205            END DO  
    224             ! upstream at closed sea outflow 
    225             IF( ncstt(jc) >= 1 ) THEN  
    226                 DO jn = 1, 4 
    227                   ji = mi0( ncsir(jc,jn) ) 
    228                   jj = mj0( ncsjr(jc,jn) ) 
    229                   upsrnfh(ji,jj) = MAX( upsrnfh(ji,jj), 1.0 ) 
    230                 END DO  
    231             ENDIF  
    232206         END DO  
    233207         IF( lk_mpp )   CALL mpp_sum ( surf, jpncs+1 )       ! mpp: sum over all the global domain 
     
    235209         IF(lwp) WRITE(numout,*)'     Closed sea surfaces' 
    236210         DO jc = 1, jpncs 
    237             IF(lwp) WRITE(numout,FMT='(1I3,4I4,5X,F16.2)')    & 
    238                 jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc) 
     211            IF(lwp)WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc) 
    239212         END DO 
    240213 
     
    243216            surf(jpncs+1) = surf(jpncs+1) - surf(jc) 
    244217         END DO            
    245   
     218         ! 
    246219      ENDIF 
    247  
    248       ! 2 - Computation 
    249       ! --------------- 
    250       zemp = 0.e0 
    251  
     220      !                                                   !--------------------! 
     221      !                                                   !  update emp, emps  ! 
     222      zemp = 0.e0                                         !--------------------! 
    252223      DO jc = 1, jpncs 
    253224         DO jj = ncsj1(jc), ncsj2(jc) 
     
    257228         END DO  
    258229      END DO 
    259       IF( lk_mpp )   CALL mpp_sum ( zemp , jpncs )       ! mpp: sum over all the global domain 
     230      IF( lk_mpp )   CALL mpp_sum ( zemp(:) , jpncs )       ! mpp: sum over all the global domain 
    260231 
    261232      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      ! Black Sea case for ORCA_R2 configuration 
     
    266237 
    267238      DO jc = 1, jpncs 
    268  
     239         ! 
    269240         IF( ncstt(jc) == 0 ) THEN  
    270241            ! water/evap excess is shared by all open ocean 
     
    303274            ENDIF  
    304275         ENDIF  
    305  
     276         ! 
    306277         DO jj = ncsj1(jc), ncsj2(jc) 
    307278            DO ji = ncsi1(jc), ncsi2(jc) 
     
    310281            END DO   
    311282         END DO  
    312  
     283         ! 
    313284      END DO  
    314  
    315  
    316       ! 5. Boundary condition on emp and emps 
    317       ! ------------------------------------- 
     285      ! 
    318286      CALL lbc_lnk( emp , 'T', 1. ) 
    319287      CALL lbc_lnk( emps, 'T', 1. ) 
    320  
    321    END SUBROUTINE flx_clo 
     288      ! 
     289   END SUBROUTINE sbc_clo 
     290    
     291    
     292   SUBROUTINE clo_rnf( p_rnfmsk ) 
     293      !!--------------------------------------------------------------------- 
     294      !!                  ***  ROUTINE sbc_rnf  *** 
     295      !!                     
     296      !! ** Purpose :   allow the treatment of closed sea outflow grid-points 
     297      !!                to be the same as river mouth grid-points 
     298      !! 
     299      !! ** Method  :   set to 1 the runoff mask (mskrnf, see sbcrnf module) 
     300      !!                at the closed sea outflow grid-point. 
     301      !! 
     302      !! ** Action  :   update (p_)mskrnf (set 1 at closed sea outflow) 
     303      !!---------------------------------------------------------------------- 
     304      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_rnfmsk   ! river runoff mask (rnfmsk array) 
     305      ! 
     306      INTEGER  ::   jc, jn      ! dummy loop indices 
     307      INTEGER  ::   ii, ij      ! temporary integer 
     308      !!---------------------------------------------------------------------- 
     309      ! 
     310      DO jc = 1, jpncs 
     311         IF( ncstt(jc) >= 1 ) THEN            ! runoff mask set to 1 at closed sea outflows 
     312             DO jn = 1, 4 
     313               ii = mi0( ncsir(jc,jn) ) 
     314               ij = mj0( ncsjr(jc,jn) ) 
     315               p_rnfmsk(ii,ij) = MAX( p_rnfmsk(ii,ij), 1.0 ) 
     316            END DO  
     317         ENDIF  
     318      END DO  
     319      ! 
     320   END SUBROUTINE clo_rnf 
     321 
     322    
     323   SUBROUTINE clo_ups( p_upsmsk ) 
     324      !!--------------------------------------------------------------------- 
     325      !!                  ***  ROUTINE sbc_rnf  *** 
     326      !!                     
     327      !! ** Purpose :   allow the treatment of closed sea outflow grid-points 
     328      !!                to be the same as river mouth grid-points 
     329      !! 
     330      !! ** Method  :   set to 0.5 the upstream mask (upsmsk, see traadv_cen2  
     331      !!                module) over the closed seas. 
     332      !! 
     333      !! ** Action  :   update (p_)upsmsk (set 0.5 over closed seas) 
     334      !!---------------------------------------------------------------------- 
     335      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_upsmsk   ! upstream mask (upsmsk array) 
     336      ! 
     337      INTEGER  ::   jc, ji, jj      ! dummy loop indices 
     338      !!---------------------------------------------------------------------- 
     339      ! 
     340      DO jc = 1, jpncs 
     341         DO jj = ncsj1(jc), ncsj2(jc) 
     342            DO ji = ncsi1(jc), ncsi2(jc) 
     343               p_upsmsk(ji,jj) = 0.5            ! mixed upstream/centered scheme over closed seas 
     344            END DO  
     345         END DO  
     346       END DO  
     347       ! 
     348   END SUBROUTINE clo_ups 
     349    
     350       
     351   SUBROUTINE clo_bat( pbat, kbat ) 
     352      !!--------------------------------------------------------------------- 
     353      !!                  ***  ROUTINE clo_bat  *** 
     354      !!                     
     355      !! ** Purpose :   suppress closed sea from the domain 
     356      !! 
     357      !! ** Method  :   set to 0 the meter and level bathymetry (given in  
     358      !!                arguments) over the closed seas. 
     359      !! 
     360      !! ** Action  :   set pbat=0 and kbat=0 over closed seas 
     361      !!---------------------------------------------------------------------- 
     362      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pbat   ! bathymetry in meters (bathy array) 
     363      INTEGER , DIMENSION(jpi,jpj), INTENT(inout) ::   kbat   ! bathymetry in levels (mbathy array) 
     364      ! 
     365      INTEGER  ::   jc, ji, jj      ! dummy loop indices 
     366      !!---------------------------------------------------------------------- 
     367      ! 
     368      DO jc = 1, jpncs 
     369         DO jj = ncsj1(jc), ncsj2(jc) 
     370            DO ji = ncsi1(jc), ncsi2(jc) 
     371               pbat(ji,jj) = 0.e0    
     372               kbat(ji,jj) = 0    
     373            END DO  
     374         END DO  
     375       END DO  
     376       ! 
     377   END SUBROUTINE clo_bat 
    322378 
    323379   !!====================================================================== 
  • trunk/NEMO/OPA_SRC/SBC/albedo.F90

    r699 r703  
    44   !! Ocean forcing:  bulk thermohaline forcing of the ocean (or ice) 
    55   !!===================================================================== 
    6    !!---------------------------------------------------------------------- 
    7    !!   flx_blk_albedo : albedo for ocean and ice (clear and overcast skies) 
    8    !!---------------------------------------------------------------------- 
    9    !! * Modules used 
     6   !! History :  8.0  !  01-04  (LIM 1.0) 
     7   !!            8.5  !  03-07  (C. Ethe, G. Madec)  Optimization (old name:shine) 
     8   !!            9.0  !  04-11  (C. Talandier)  add albedo_init 
     9   !!            9.0  !  06-08  (G. Madec)  cleaning for surface module 
     10   !!---------------------------------------------------------------------- 
     11 
     12   !!---------------------------------------------------------------------- 
     13   !!   blk_albedo  : albedo for ocean and ice (clear and overcast skies) 
     14   !!   albedo_init : initialisation 
     15   !!---------------------------------------------------------------------- 
    1016   USE oce             ! ocean dynamics and tracers 
    11    USE dom_oce         ! ocean space and time domain 
    12    USE cpl_oce         ! ??? 
    1317   USE phycst          ! physical constants 
    14    USE daymod 
    15    USE blk_oce         ! bulk variables 
    16    USE flx_oce         ! forcings variables 
    17    USE ocfzpt          ! ??? 
    1818   USE in_out_manager 
    19    USE lbclnk 
    2019 
    2120   IMPLICIT NONE 
    2221   PRIVATE 
    2322 
    24    !! * Accessibility 
    25    PUBLIC flx_blk_albedo ! routine called by limflx.F90 in coupled 
    26                          ! and in flxblk.F90 in forced 
    27    !! * Module variables 
    28    INTEGER  ::             &  !: nameos : ocean physical parameters 
    29       albd_init = 0           !: control flag for initialization 
    30  
    31    REAL(wp)  ::            &  ! constant values 
    32       zzero   = 0.e0    ,  & 
    33       zone    = 1.0 
    34  
    35    !! * constants for albedo computation (flx_blk_albedo) 
     23   PUBLIC   blk_albedo   ! routine called by sbcice_lim module 
     24 
     25   INTEGER  ::   albd_init = 0    !: control flag for initialization 
     26 
     27   REAL(wp) ::   zzero   = 0.e0   ! constant values 
     28   REAL(wp) ::   zone    = 1.e0   !    "       " 
     29 
     30   REAL(wp) ::   c1     = 0.05    ! constants values 
     31   REAL(wp) ::   c2     = 0.10    !    "        " 
     32   REAL(wp) ::   cmue   = 0.40    !  cosine of local solar altitude 
     33 
     34   !!* namelist namalb 
    3635   REAL(wp) ::   & 
    37       c1     = 0.05  ,     &   ! constants values 
    38       c2     = 0.10  ,     & 
     36      cgren  = 0.06  ,     &   !  correction of the snow or ice albedo to take into account 
     37      !                        !  effects of cloudiness (Grenfell & Perovich, 1984) 
    3938      albice = 0.50  ,     &   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 
    40       cgren  = 0.06  ,     &   !  correction of the snow or ice albedo to take into account 
    41                                !  effects of cloudiness (Grenfell & Perovich, 1984) 
    4239      alphd  = 0.80  ,     &   !  coefficients for linear interpolation used to compute 
    4340      alphdi = 0.72  ,     &   !  albedo between two extremes values (Pyane, 1972) 
    44       alphc  = 0.65  ,     & 
    45       zmue   = 0.40            !  cosine of local solar altitude 
    46  
    47    !!---------------------------------------------------------------------- 
    48    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     41      alphc  = 0.65  
     42   NAMELIST/namalb/ cgren, albice, alphd, alphdi, alphc 
     43 
     44   !!---------------------------------------------------------------------- 
     45   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    4946   !! $Id$ 
    50    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     47   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5148   !!---------------------------------------------------------------------- 
    5249 
     
    5855   !!---------------------------------------------------------------------- 
    5956 
    60    SUBROUTINE flx_blk_albedo( palb , palcn , palbp , palcnp ) 
    61       !!---------------------------------------------------------------------- 
    62       !!               ***  ROUTINE flx_blk_albedo  *** 
     57   SUBROUTINE blk_albedo( palb , palcn , palbp , palcnp ) 
     58      !!---------------------------------------------------------------------- 
     59      !!               ***  ROUTINE blk_albedo  *** 
    6360      !!           
    6461      !! ** Purpose :   Computation of the albedo of the snow/ice system  
    65       !!      as well as the ocean one 
     62      !!                as well as the ocean one 
    6663      !!        
    6764      !! ** Method  : - Computation of the albedo of snow or ice (choose the  
    68       !!      rignt one by a large number of tests 
     65      !!                rignt one by a large number of tests 
    6966      !!              - Computation of the albedo of the ocean 
    7067      !! 
    71       !! References : 
    72       !!      Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250. 
    73       !! 
    74       !! History : 
    75       !!  8.0   !  01-04  (LIM 1.0) 
    76       !!  8.5   !  03-07  (C. Ethe, G. Madec)  Optimization (old name:shine) 
    77       !!---------------------------------------------------------------------- 
    78       !! * Modules used 
    79       USE ice                   ! ??? 
    80  
    81       !! * Arguments 
    82       REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::  & 
    83          palb         ,     &    !  albedo of ice under overcast sky 
    84          palcn        ,     &    !  albedo of ocean under overcast sky 
    85          palbp        ,     &    !  albedo of ice under clear sky  
    86          palcnp                  !  albedo of ocean under clear sky 
    87  
    88       !! * Local variables 
    89       INTEGER ::    & 
    90          ji, jj                   ! dummy loop indices 
    91       REAL(wp) ::   &  
    92          zmue14         ,     &   !  zmue**1.4 
     68      !! References :   Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250. 
     69      !!---------------------------------------------------------------------- 
     70      USE ice             ! ??? 
     71      !! 
     72      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palb     ! albedo of ice under overcast sky 
     73      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palcn    ! albedo of ocean under overcast sky 
     74      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palbp    ! albedo of ice under clear sky  
     75      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palcnp   ! albedo of ocean under clear sky 
     76      !! 
     77      INTEGER  ::   ji, jj                   ! dummy loop indices 
     78      REAL(wp) ::   zcoef,    &   ! temporary scalar 
    9379         zalbpsnm       ,     &   !  albedo of ice under clear sky when snow is melting 
    9480         zalbpsnf       ,     &   !  albedo of ice under clear sky when snow is freezing 
     
    9985         zihsc1         ,     &   !  = 1 hsn <= c1 ; = 0 hsn > c1 
    10086         zihsc2                   !  = 1 hsn >= c2 ; = 0 hsn < c2 
    101       REAL(wp), DIMENSION(jpi,jpj) ::  & 
    102          zalbfz         ,     &   !  ( = alphdi for freezing ice ; = albice for melting ice ) 
    103          zficeth                  !  function of ice thickness 
    104       LOGICAL , DIMENSION(jpi,jpj) ::  & 
    105          llmask 
     87      LOGICAL , DIMENSION(jpi,jpj) ::   llmask    !  
     88      REAL(wp), DIMENSION(jpi,jpj) ::   zalbfz    ! ( = alphdi for freezing ice ; = albice for melting ice ) 
     89      REAL(wp), DIMENSION(jpi,jpj) ::   zficeth   ! function of ice thickness 
    10690      !!--------------------------------------------------------------------- 
    10791       
    108       ! initialization  
    109       IF( albd_init == 0 )   CALL albedo_init 
    110  
    111       !-------------------------                                                              
     92      IF( albd_init == 0 )   CALL albedo_init      ! initialization  
     93 
     94      !--------------------------- 
    11295      !  Computation of  zficeth 
    113       !--------------------------  
     96      !--------------------------- 
    11497       
    11598      llmask = (hsnif == 0.e0) .AND. ( sist >= rt0_ice ) 
     
    175158      !-------------------------- -----------------                                                           
    176159       
    177       !  Parameterization of Briegled and Ramanathan, 1982  
    178       zmue14      = zmue**1.4                                        
    179       palcnp(:,:) = 0.05 / ( 1.1 * zmue14 + 0.15 )                 
    180        
    181       !  Parameterization of Kondratyev, 1969 and Payne, 1972 
    182       palcn(:,:)  = 0.06                                                  
    183        
    184    END SUBROUTINE flx_blk_albedo 
     160      zcoef = 0.05 / ( 1.1 * cmue**1.4 + 0.15 )        ! Parameterization of Briegled and Ramanathan, 1982  
     161      palcnp(:,:) = zcoef 
     162      palcn(:,:)  = 0.06                               ! Parameterization of Kondratyev, 1969 and Payne, 1972 
     163      ! 
     164   END SUBROUTINE blk_albedo 
    185165 
    186166# else 
     
    189169   !!---------------------------------------------------------------------- 
    190170 
    191    SUBROUTINE flx_blk_albedo( palb , palcn , palbp , palcnp ) 
    192       !!---------------------------------------------------------------------- 
    193       !!               ***  ROUTINE flx_blk_albedo  *** 
     171   SUBROUTINE blk_albedo( palb , palcn , palbp , palcnp ) 
     172      !!---------------------------------------------------------------------- 
     173      !!               ***  ROUTINE blk_albedo  *** 
    194174      !!  
    195       !! ** Purpose :   Computation of the albedo of the snow/ice system 
    196       !!      as well as the ocean one 
    197       !! 
    198       !! ** Method  :   Computation of the albedo of snow or ice (choose the 
    199       !!      wright one by a large number of tests Computation of the albedo 
    200       !!      of the ocean 
    201       !! 
    202       !! History : 
    203       !!  8.0   !  01-04  (LIM 1.0) 
    204       !!  8.5   !  03-07  (C. Ethe, G. Madec)  Optimization (old name:shine) 
    205       !!---------------------------------------------------------------------- 
    206       !! * Arguments 
    207       REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::  & 
    208          palb         ,     &    !  albedo of ice under overcast sky 
    209          palcn        ,     &    !  albedo of ocean under overcast sky 
    210          palbp        ,     &    !  albedo of ice under clear sky 
    211          palcnp                  !  albedo of ocean under clear sky 
    212  
    213       REAL(wp) ::   & 
    214          zmue14                 !  zmue**1.4 
    215       !!---------------------------------------------------------------------- 
    216  
    217       !-------------------------------------------- 
    218       !    Computation of the albedo of the ocean 
    219       !-------------------------- ----------------- 
    220  
    221       !  Parameterization of Briegled and Ramanathan, 1982 
    222       zmue14      = zmue**1.4 
    223       palcnp(:,:) = 0.05 / ( 1.1 * zmue14 + 0.15 ) 
    224  
    225       !  Parameterization of Kondratyev, 1969 and Payne, 1972 
    226       palcn(:,:)  = 0.06 
    227  
    228       palb (:,:)  = palcn(:,:) 
    229       palbp(:,:)  = palcnp(:,:) 
    230  
    231    END SUBROUTINE flx_blk_albedo 
     175      !! ** Purpose :   Computation of the albedo of the ocean 
     176      !! 
     177      !! ** Method  :   .... 
     178      !!---------------------------------------------------------------------- 
     179      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palb     ! albedo of ice under overcast sky 
     180      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palcn    ! albedo of ocean under overcast sky 
     181      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palbp    ! albedo of ice under clear sky 
     182      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palcnp   ! albedo of ocean under clear sky 
     183      !! 
     184      REAL(wp) ::   zcoef    ! temporary scalar 
     185      !!---------------------------------------------------------------------- 
     186      ! 
     187      zcoef = 0.05 / ( 1.1 * cmue**1.4 + 0.15 ) 
     188 
     189      palcnp(:,:) = zcoef           ! Parameterization of Briegled and Ramanathan, 1982 
     190      palcn(:,:)  = 0.06            ! Parameterization of Kondratyev, 1969 and Payne, 1972 
     191 
     192      palb (:,:)  = zcoef           ! ice overcast  albedo set to oceanvalue 
     193      palbp(:,:)  = 0.06            ! ice clear sky albedo set to oceanvalue 
     194      ! 
     195   END SUBROUTINE blk_albedo 
    232196 
    233197#endif 
     
    240204      !! 
    241205      !! ** Method  :   Read the namelist namalb 
    242       !! 
    243       !! ** Action  :   
    244       !! 
    245       !! 
    246       !! History : 
    247       !!   9.0  !  04-11  (C. Talandier)  Original code 
    248       !!---------------------------------------------------------------------- 
    249       NAMELIST/namalb/ cgren, albice, alphd, alphdi, alphc 
    250       !!---------------------------------------------------------------------- 
    251       !!  OPA 9.0, LODYC-IPSL (2004) 
    252       !!---------------------------------------------------------------------- 
    253  
    254       ! set the initialization flag to 1 
    255       albd_init = 1           ! indicate that the initialization has been done 
    256  
    257       ! Read Namelist namalb : albedo parameters 
    258       REWIND( numnam ) 
     206      !!---------------------------------------------------------------------- 
     207      ! 
     208      albd_init = 1              ! set the initialization flag to 1 (done) 
     209 
     210      REWIND( numnam )           ! Read Namelist namalb : albedo parameters 
    259211      READ  ( numnam, namalb ) 
    260212 
    261       ! Control print 
    262       IF(lwp) THEN 
     213      IF(lwp) THEN               ! Control print 
    263214         WRITE(numout,*) 
    264          WRITE(numout,*) 'albedo_init : albedo ' 
     215         WRITE(numout,*) 'albedo_init : set albedo parameters from namelist namalb' 
    265216         WRITE(numout,*) '~~~~~~~~~~~' 
    266          WRITE(numout,*) '          Namelist namalb : set albedo parameters' 
    267          WRITE(numout,*) 
    268          WRITE(numout,*) '             correction of the snow or ice albedo to take into account cgren = ', cgren 
    269          WRITE(numout,*) '             albedo of melting ice in the arctic and antarctic        albice = ', albice 
    270          WRITE(numout,*) '             coefficients for linear                                   alphd = ', alphd 
    271          WRITE(numout,*) '             interpolation used to compute albedo                     alphdi = ', alphdi 
    272          WRITE(numout,*) '             between two extremes values (Pyane, 1972)                 alphc = ', alphc 
    273          WRITE(numout,*) 
     217         WRITE(numout,*) '             correction for snow and ice albedo                    cgren  = ', cgren 
     218         WRITE(numout,*) '             albedo of melting ice in the arctic and antarctic     albice = ', albice 
     219         WRITE(numout,*) '             coefficients for linear                               alphd  = ', alphd 
     220         WRITE(numout,*) '             interpolation used to compute albedo                  alphdi = ', alphdi 
     221         WRITE(numout,*) '             between two extremes values (Pyane, 1972)             alphc  = ', alphc 
    274222      ENDIF 
    275  
     223      ! 
    276224   END SUBROUTINE albedo_init 
     225 
    277226   !!====================================================================== 
    278227END MODULE albedo 
  • trunk/NEMO/OPA_SRC/daymod.F90

    r699 r703  
    44   !! Ocean        :  calendar  
    55   !!===================================================================== 
     6   !! History :        !  94-09  (M. Pontaud M. Imbard)  Original code 
     7   !!                  !  97-03  (O. Marti) 
     8   !!                  !  97-05  (G. Madec)  
     9   !!                  !  97-08  (M. Imbard) 
     10   !!             9.0  !  03-09  (G. Madec)  F90 + nyear, nmonth, nday 
     11   !!                  !  04-01  (A.M. Treguier) new calculation based on adatrj 
     12   !!                  !  06-08  (G. Madec)  surface module major update 
     13   !!----------------------------------------------------------------------       
    614 
    715   !!---------------------------------------------------------------------- 
    816   !!   day        : calendar 
    917   !!---------------------------------------------------------------------- 
    10    !! * Modules used 
    1118   USE dom_oce         ! ocean space and time domain 
    1219   USE phycst          ! physical constants 
     
    1724   PRIVATE 
    1825 
    19    !! * Routine accessibility 
    2026   PUBLIC day        ! called by step.F90 
    2127 
    22    !! * Shared module variables 
    23    INTEGER , PUBLIC ::   &  !: 
    24       nyear     ,   &  !: current year 
    25       nmonth    ,   &  !: current month 
    26       nday      ,   &  !: current day of the month 
    27       nday_year ,   &  !: curent day counted from jan 1st of the current year 
    28       ndastp           !: time step date in year/month/day aammjj 
    29    REAL(wp), PUBLIC ::   &  !: 
    30        adatrj   ,   &  !: number of elapsed days since the begining of the run 
    31        adatrj0         !: value of adatrj at nit000-1 (before the present run). 
    32        !               !  it is the accumulated duration of previous runs 
    33        !               !  that may have been run with different time steps. 
     28   INTEGER , PUBLIC ::   nyear       !: current year 
     29   INTEGER , PUBLIC ::   nmonth      !: current month 
     30   INTEGER , PUBLIC ::   nday        !: current day of the month 
     31   INTEGER , PUBLIC ::   nday_year   !: current day counted from jan 1st of the current year 
     32   REAL(wp), PUBLIC ::   rsec_year   !: current time step counted in second since 00h jan 1st of the current year 
     33   REAL(wp), PUBLIC ::   rsec_month  !: current time step counted in second since 00h 1st day of the current month 
     34   REAL(wp), PUBLIC ::   rsec_day    !: current time step counted in second since 00h         of the current day 
     35   INTEGER , PUBLIC ::   ndastp      !: time step date in year/month/day aammjj 
     36 
     37!!gm supprimer adatrj et adatrj0 ==> remplacer par rsecday..... 
     38   REAL(wp), PUBLIC ::   adatrj      !: number of elapsed days since the begining of the run 
     39   REAL(wp), PUBLIC ::   adatrj0     !: value of adatrj at nit000-1 (before the present run). 
     40   !                                 !  it is the accumulated duration of previous runs 
     41   !                                 !  that may have been run with different time steps. 
     42   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len   !: length of the current year 
     43 
     44   INTEGER, PUBLIC, DIMENSION(12) ::   nbiss = (/ 31, 29, 31, 30, 31, 30,    &  !: number of days per month 
     45      &                                           31, 31, 30, 31, 30, 31 /)     !: (leap-year) 
     46   INTEGER, PUBLIC, DIMENSION(12) ::   nobis = (/ 31, 28, 31, 30, 31, 30,    &  !: number of days per month 
     47      &                                           31, 31, 30, 31, 30, 31 /)     !: (365 days a year) 
     48 
     49   REAL(wp), PUBLIC, DIMENSION(0:14) ::   rmonth_half(0:14) 
     50 
    3451   !!---------------------------------------------------------------------- 
    35    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     52   !!  OPA 9.0 , LOCEAN-IPSL (2006)  
    3653   !! $Id$ 
    37    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     54   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3855   !!---------------------------------------------------------------------- 
    3956 
     
    5471      !!              - ndastp    : =nyear*10000+nmonth*100+nday 
    5572      !!              - adatrj    : date in days since the beginning of the run 
    56       !! 
    57       !! History : 
    58       !!        !  94-09  (M. Pontaud M. Imbard)  Original code 
    59       !!        !  97-03  (O. Marti) 
    60       !!        !  97-05  (G. Madec)  
    61       !!        !  97-08  (M. Imbard) 
    62       !!   9.0  !  03-09  (G. Madec)  F90 + nyear, nmonth, nday 
    63       !!        !  04-01  (A.M. Treguier) new calculation based on adatrj 
     73      !!              - rsec_year : current time of the year (in second since 00h, jan 1st) 
    6474      !!----------------------------------------------------------------------       
    65       !! * Arguments 
    66       INTEGER, INTENT( in ) ::   kt      ! ocean time-step indices 
    67  
    68       !! * Local declarations 
    69       INTEGER  ::   js                   ! dummy loop indice 
    70       INTEGER  ::   iend, iday0, iday1   ! temporary integers 
    71       REAL(wp) :: zadatrjn, zadatrjb     ! adatrj at timestep kt-1 and kt-2  
    72       CHARACTER (len=25) :: charout 
     75      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices 
     76      ! 
     77      INTEGER  ::   js, jm               ! dummy loop indice 
     78      CHARACTER (len=25) ::   charout 
    7379      !!---------------------------------------------------------------------- 
    7480 
     
    7783      !----------------------------------------------------------------- 
    7884 
    79       IF( kt == nit000 ) THEN 
    80  
     85      !                        ! ---------------- ! 
     86      IF( kt == -1 ) THEN      !  Initialisation  ! 
     87         !                     ! ---------------- ! 
     88         ! 
    8189         IF( .NOT.ln_rstart )   adatrj0 = 0.e0      ! adatrj0 initialized in rst_read when restart  
    8290 
    83          adatrj  = adatrj0 
     91         ! set the calandar from adatrj0 and ndastp (read in restart file and namelist) 
     92         adatrj  =   adatrj0      !???? bug.... toujours rest   !!gm 
    8493         nyear   =   ndastp / 10000 
    8594         nmonth  = ( ndastp - (nyear * 10000) ) / 100 
    8695         nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 )  
    8796 
    88          ! Calculates nday_year, day since january 1st (useful to read  daily forcing fields) 
     97         ! length of the month of the current year (from nleapy, read in namelist) 
     98         nmonth_len(0) = nbiss(12)   ;   nmonth_len(13) = nbiss(1) 
     99         SELECT CASE( nleapy ) 
     100         CASE( 1  )    
     101            IF( MOD( nyear, 4 ) == 0 ) THEN 
     102               ;          nmonth_len(1:12) = nbiss(:)      ! 366 days per year (leap year) 
     103            ELSE 
     104               ;          nmonth_len(1:12) = nobis(:)      ! 365 days per year 
     105            ENDIF 
     106         CASE( 0  )   ;   nmonth_len(1:12) = nobis(:)      ! 365 days per year 
     107         CASE( 2: )   ;   nmonth_len(1:13) = nleapy        ! 12*nleapy days per year 
     108         END SELECT 
     109 
     110         ! half month in second since the bigining of the year 
     111         rmonth_half(0) = - 0.5 * rday * REAL( nmonth_len( 0 ) ) 
     112         DO jm = 1, 12 
     113            rmonth_half(jm) = rmonth_half(jm-1) + 0.5 * rday * REAL( nmonth_len(jm-1) + nmonth_len(jm) ) 
     114         END DO 
     115         rmonth_half(13) = rmonth_half( 1 ) + 365. * rday 
     116         rmonth_half(14) = rmonth_half( 2 ) + 365. * rday 
     117 
     118         ! day since january 1st (useful to read  daily forcing fields) 
    89119         nday_year =  nday 
    90          !                               ! accumulates days of previous months of this year 
    91          DO js = 1, nmonth-1 
    92             IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN 
    93                nday_year = nday_year + nbiss(js) 
    94             ELSE 
    95                nday_year = nday_year + nobis(js) 
    96             ENDIF 
     120         DO js = 1, nmonth - 1             ! accumulates days of previous months of this year 
     121            nday_year = nday_year + nmonth_len(js) 
    97122         END DO 
    98123 
    99       ENDIF 
     124         ! number of seconds since... 
     125         rsec_year  = REAL( nday_year - 1 ) * rday - rdttra(1)      ! 00h 1st day of the current year 
     126         rsec_day   = REAL( nday      - 1 ) * rday - rdttra(1)      ! 00h 1st day of the current month 
     127         rsec_month =                              - rdttra(1)      ! 00h         of the current day 
    100128 
    101       ! I.  calculates adatrj, zadatrjn, zadatrjb. 
    102       ! ------------------------------------------------------------------ 
     129         ! control print 
     130         IF(lwp) WRITE(numout,*)' ==============>> time-step =', kt, ' Initial DATE= ',   & 
     131               &                   nyear, '/', nmonth, '/', nday, '  rsec_day:', rsec_day 
    103132 
    104       adatrj    = adatrj0 + ( kt - nit000 + 1 ) * rdttra(1) / rday 
    105       zadatrjn  = adatrj0 + ( kt - nit000     ) * rdttra(1) / rday 
    106       zadatrjb  = adatrj0 + ( kt - nit000 - 1 ) * rdttra(1) / rday 
     133         ! 
     134         !                     ! -------------------------------- !  
     135      ELSE                     !  Model calendar at time-step kt  ! 
     136         !                     ! -------------------------------- !  
    107137 
     138         rsec_year  = rsec_year  + rdttra(1)                 ! New time-step 
     139         rsec_month = rsec_month + rdttra(1)                 ! New time-step 
     140         rsec_day   = rsec_day   + rdttra(1)                 ! New time-step 
    108141 
    109       ! II.  increment the date.  The date corresponds to 'now' variables (kt-1), 
    110       !      which is the time step of forcing fields.  
    111       !      Do not do this at nit000  unless nrstdt= 2 
    112       !      In that case ndastp (read in restart) was for step nit000-2 
    113       ! ------------------------------------------------------------------- 
     142         adatrj    = adatrj0 + ( kt - nit000 + 1 ) * rdttra(1) / rday 
    114143 
    115       iday0 = INT( zadatrjb ) 
    116       iday1 = INT( zadatrjn ) 
     144         IF( rsec_day >= rday ) THEN 
     145            ! 
     146            rsec_day  = 0.e0                               ! NEW day 
     147            nday      = nday + 1 
     148            nday_year = nday_year + 1 
     149            ! 
     150            IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! NEW month 
     151               nday  = 1 
     152               rsec_month = 0.e0    
     153               nmonth = nmonth + 1 
     154               IF( nmonth == 13 ) THEN                     ! NEW year 
     155                  nyear     = nyear + 1 
     156                  nmonth    = 1 
     157                  nday_year = 1 
     158                  rsec_year = 0.e0 
     159                  !                                        ! update the length of the month 
     160                  IF( nleapy == 1 ) THEN                   ! of the current year (if necessary) 
     161                     IF( MOD( nyear, 4 ) == 0 ) THEN 
     162                        nmonth_len(1:12) = nbiss(:)              ! 366 days per year (leap year) 
     163                     ELSE 
     164                        nmonth_len(1:12) = nobis(:)              ! 365 days per year 
     165                     ENDIF 
     166                     ! half month in second since the bigining of the year 
     167                     rmonth_half(0) = - 0.5 * rday * REAL( nmonth_len( 0 ) ) 
     168                     DO jm = 1, 12 
     169                        rmonth_half(jm) = rmonth_half(jm-1) + 0.5 * rday * REAL( nmonth_len(jm-1) + nmonth_len(jm) ) 
     170                     END DO 
     171                     rmonth_half(13) = rmonth_half( 1 ) + 365. * rday 
     172                     rmonth_half(14) = rmonth_half( 2 ) + 365. * rday 
     173                  ENDIF 
     174               ENDIF 
     175            ENDIF 
    117176 
    118       IF( iday1 - iday0 >= 1 .AND. ( kt /= nit000 .OR. nrstdt == 2 ) ) THEN 
     177            ! 
     178            ndastp = nyear * 10000 + nmonth * 100 + nday   ! NEW date 
     179            ! 
     180!           IF(lwp) WRITE(numout,'(a,i8,a,i4,a,i2,a,i2,a,i3)') '======>> time-step =', kt,   & 
     181!              &   '      New day, DATE= ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year 
     182!           IF(lwp) WRITE(numout,'(a,F9.0,a,F9.0,a,F9.0)') '         rsec_year = ', rsec_year,   & 
     183!              &   '   rsec_month = ', rsec_month, '   rsec_day = ', rsec_day 
     184         ENDIF 
    119185 
    120          ! increase calendar 
    121          nyear  =   ndastp / 10000 
    122          nmonth = ( ndastp - (nyear * 10000) ) / 100 
    123          nday   =   ndastp - (nyear * 10000) - ( nmonth * 100 )  
    124          nday = nday + 1 
    125          IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN 
    126             iend = nbiss(nmonth) 
    127          ELSEIF( nleapy > 1 ) THEN  
    128             iend = nleapy 
    129          ELSE  
    130             iend = nobis(nmonth) 
     186         IF(ln_ctl) THEN 
     187            WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
     188            CALL prt_ctl_info(charout) 
    131189         ENDIF 
    132          IF( nday == iend + 1 ) THEN 
    133             nday  = 1 
    134             nmonth = nmonth + 1 
    135             IF( nmonth == 13 ) THEN 
    136                nmonth  = 1 
    137                nyear = nyear + 1 
    138             ENDIF 
    139          ENDIF 
    140          ndastp = nyear * 10000 + nmonth * 100 + nday 
    141  
    142          ! Calculates nday_year, day since january 1st (useful to read  daily forcing fields) 
    143          nday_year =  nday 
    144          !                                ! accumulates days of previous months of this year 
    145          DO js = 1, nmonth-1 
    146             IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN 
    147                nday_year = nday_year + nbiss(js) 
    148             ELSE 
    149                nday_year = nday_year + nobis(js) 
    150             ENDIF 
    151          END DO 
    152  
    153          IF(lwp) WRITE(numout,*)' ==============>> time-step =', kt, ' New day, DATE= ',   & 
    154             &                   nyear, '/', nmonth, '/', nday, 'nday_year:', nday_year 
    155       ENDIF 
    156  
    157       IF(ln_ctl) THEN 
    158          WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
    159          CALL prt_ctl_info(charout, itime=kt) 
     190         ! 
    160191      ENDIF 
    161192 
  • trunk/NEMO/OPA_SRC/eosbn2.F90

    r699 r703  
    55   !!                                               - Brunt-Vaisala frequency  
    66   !!============================================================================== 
     7   !! History :       !  89-03  (O. Marti)  Original code 
     8   !!            6.0  !  94-07  (G. Madec, M. Imbard)  add bn2 
     9   !!            6.0  !  94-08  (G. Madec)  Add Jackett & McDougall eos 
     10   !!            7.0  !  96-01  (G. Madec)  statement function for e3 
     11   !!            8.1  !  97-07  (G. Madec)  introduction of neos, OPA8.1 
     12   !!            8.1  !  97-07  (G. Madec)  density instead of volumic mass 
     13   !!                 !  99-02  (G. Madec, N. Grima) semi-implicit pressure gradient 
     14   !!                 !  01-09  (M. Ben Jelloul)  bugfix onlinear eos 
     15   !!            8.5  !  02-10  (G. Madec)  add eos_init 
     16   !!            8.5  !  02-11  (G. Madec, A. Bozec)  partial step, eos_insitu_2d 
     17   !!            9.0  !  03-08  (G. Madec)  F90, free form 
     18   !!            9.0  !  06-08  (G. Madec)  add tfreez function 
     19   !!---------------------------------------------------------------------- 
    720 
    821   !!---------------------------------------------------------------------- 
     
    1326   !!   eos_insitu_2d  : Compute the in situ density for 2d fields 
    1427   !!   eos_bn2        : Compute the Brunt-Vaisala frequency 
     28   !!   tfreez         : Compute the surface freezing temperature 
    1529   !!   eos_init       : set eos parameters (namelist) 
    1630   !!---------------------------------------------------------------------- 
    17    !! * Modules used 
    1831   USE dom_oce         ! ocean space and time domain 
    1932   USE phycst          ! physical constants 
     
    3346   END INTERFACE  
    3447 
    35    !! * Routine accessibility 
    36    PUBLIC eos        ! called by step.F90, inidtr.F90, tranpc.F90 and intgrd.F90 
    37    PUBLIC bn2        ! called by step.F90 
    38    PUBLIC eos_init   ! called by step.F90 
    39  
    40    !! * Share module variables 
    41    INTEGER , PUBLIC ::   &  !: nameos : ocean physical parameters 
    42       neos      = 0,     &  !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
    43       neos_init = 0         !: control flag for initialization 
    44  
    45    REAL(wp), PUBLIC ::   &  !: nameos : ocean physical parameters 
    46       ralpha = 2.0e-4,   &  !: thermal expension coeff. (linear equation of state) 
    47       rbeta  = 7.7e-4       !: saline  expension coeff. (linear equation of state) 
     48   PUBLIC   eos        ! called by step, istate, tranpc and zpsgrd modules 
     49   PUBLIC   bn2        ! called by step module 
     50   PUBLIC   tfreez     ! called by sbcice_... modules 
     51 
     52   !!* Namelist (nameos) 
     53   INTEGER , PUBLIC ::   neos   = 0        !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
     54   REAL(wp), PUBLIC ::   ralpha = 2.0e-4   !: thermal expension coeff. (linear equation of state) 
     55   REAL(wp), PUBLIC ::   rbeta  = 7.7e-4   !: saline  expension coeff. (linear equation of state) 
     56   NAMELIST/nameos/ neos, ralpha, rbeta 
    4857    
     58   INTEGER ::   neos_init = 0         !: control flag for initialization 
     59 
    4960   !! * Substitutions 
    5061#  include "domzgr_substitute.h90" 
    5162#  include "vectopt_loop_substitute.h90" 
    5263   !!---------------------------------------------------------------------- 
    53    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     64   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    5465   !! $Id$ 
    55    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     66   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5667   !!---------------------------------------------------------------------- 
    5768 
    5869CONTAINS 
    5970 
    60    SUBROUTINE eos_insitu ( ptem, psal, prd ) 
     71   SUBROUTINE eos_insitu( ptem, psal, prd ) 
    6172      !!---------------------------------------------------------------------- 
    6273      !!                   ***  ROUTINE eos_insitu  *** 
     
    92103      !! ** Action  :   compute prd , the in situ density (no units) 
    93104      !! 
    94       !! References : 
    95       !!      Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994 
    96       !! 
    97       !! History : 
    98       !!        !  89-03 (o. Marti)  Original code 
    99       !!        ! 94-08 (G. Madec) 
    100       !!        !  96-01 (G. Madec) statement function for e3 
    101       !!        !  97-07 (G. Madec) introduction of neos, OPA8.1 
    102       !!        !  97-07 (G. Madec) density instead of volumic mass 
    103       !!        !  99-02 (G. Madec, N. Grima) semi-implicit pressure gradient 
    104       !!        !  01-09 (M. Ben Jelloul) bugfix    
    105       !!---------------------------------------------------------------------- 
    106       !! * Arguments 
    107       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   & 
    108          ptem,                 &  ! potential temperature 
    109          psal                     ! salinity 
    110       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   & 
    111          prd                      ! potential density (surface referenced) 
    112  
    113       !! * Local declarations 
     105      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
     106      !!---------------------------------------------------------------------- 
     107      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptem   ! potential temperature  [Celcius] 
     108      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   psal   ! salinity               [psu] 
     109      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   prd    ! in situ density  
     110      !! 
    114111      INTEGER ::  ji, jj, jk      ! dummy loop indices 
    115112      REAL(wp) ::   &           
     
    119116         zd , zc , zaw, za ,   &  !    "         " 
    120117         zb1, za1, zkw, zk0       !    "         " 
    121       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    122          zws                      ! temporary workspace 
    123       !!---------------------------------------------------------------------- 
    124  
    125  
    126       ! initialization (in not already done) 
    127       IF( neos_init == 0 ) CALL eos_init 
    128  
     118      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zws   ! temporary workspace 
     119      !!---------------------------------------------------------------------- 
     120 
     121      IF( neos_init == 0 ) CALL eos_init      ! initialization (in not already done) 
    129122 
    130123      SELECT CASE ( neos ) 
    131  
     124      ! 
    132125      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    133  
     126         ! 
    134127!CDIR NOVERRCHK 
    135128         zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) ) 
    136  
    137129         !                                                ! =============== 
    138130         DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    181173         END DO                                           !   End of slab 
    182174         !                                                ! =============== 
    183  
    184  
     175         ! 
    185176      CASE ( 1 )               ! Linear formulation function of temperature only 
    186  
     177         ! 
    187178         !                                                ! =============== 
    188179         DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    199190         END DO                                           !   End of slab 
    200191         !                                                ! =============== 
    201  
    202  
     192         ! 
    203193      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    204  
     194         ! 
    205195         !                                                ! =============== 
    206196         DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    217207         END DO                                           !   End of slab 
    218208         !                                                ! =============== 
    219  
     209         ! 
    220210      CASE DEFAULT 
    221  
     211         ! 
    222212         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    223213         CALL ctl_stop( ctmp1 ) 
    224  
     214         ! 
    225215      END SELECT 
    226  
    227       IF(ln_ctl)   THEN 
    228          CALL prt_ctl(tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk) 
    229       ENDIF 
    230  
     216      ! 
     217      IF(ln_ctl)   CALL prt_ctl(tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk) 
     218      ! 
    231219   END SUBROUTINE eos_insitu 
    232220 
    233221 
    234    SUBROUTINE eos_insitu_pot ( ptem, psal, prd, prhop) 
     222   SUBROUTINE eos_insitu_pot( ptem, psal, prd, prhop ) 
    235223      !!---------------------------------------------------------------------- 
    236224      !!                  ***  ROUTINE eos_insitu_pot  *** 
     
    275263      !!              - prhop, the potential volumic mass (Kg/m3) 
    276264      !! 
    277       !! References : 
    278       !!      Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994 
    279       !!      Brown, J. A. and K. A. Campana. Mon. Weather Rev., 1978 
    280       !! 
    281       !! History : 
    282       !!   4.0  !  89-03  (O. Marti) 
    283       !!        !  94-08  (G. Madec) 
    284       !!        !  96-01  (G. Madec) statement function for e3 
    285       !!        !  97-07  (G. Madec) introduction of neos, OPA8.1 
    286       !!        !  97-07  (G. Madec) density instead of volumic mass 
    287       !!        !  99-02  (G. Madec, N. Grima) semi-implicit pressure gradient 
    288       !!        !  01-09  (M. Ben Jelloul) bugfix    
    289       !!   9.0  !  03-08  (G. Madec)  F90, free form 
    290       !!---------------------------------------------------------------------- 
    291       !! * Arguments 
    292       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   & 
    293          ptem,   &  ! potential temperature 
    294          psal       ! salinity 
    295       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   & 
    296          prd,    &  ! potential density (surface referenced) 
    297          prhop      ! potential density (surface referenced) 
    298  
    299       !! * Local declarations 
     265      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
     266      !!                Brown and Campana, Mon. Weather Rev., 1978 
     267      !!---------------------------------------------------------------------- 
     268      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptem   ! potential temperature  [Celcius] 
     269      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   psal   ! salinity               [psu] 
     270      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   prd    ! in situ density  
     271      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     272 
    300273      INTEGER  ::  ji, jj, jk                ! dummy loop indices 
    301274      REAL(wp) ::   &             ! temporary scalars 
    302275         zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw,   & 
    303276         zb, zd, zc, zaw, za, zb1, za1, zkw, zk0 
    304       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zws 
    305       !!---------------------------------------------------------------------- 
    306  
    307       ! initialization (in not already done) 
    308       IF( neos_init == 0 ) CALL eos_init 
    309  
     277      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zws 
     278      !!---------------------------------------------------------------------- 
     279 
     280      IF( neos_init == 0 ) CALL eos_init      ! initialization (in not already done) 
    310281 
    311282      SELECT CASE ( neos ) 
    312  
     283      ! 
    313284      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    314  
     285         ! 
    315286!CDIR NOVERRCHK 
    316287         zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) ) 
    317  
    318288         !                                                ! =============== 
    319289         DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    326296                  zh = fsdept(ji,jj,jk) 
    327297                  ! square root salinity 
    328 !!Edmee           zsr= SQRT( ABS( zs ) ) 
    329298                  zsr= zws(ji,jj,jk) 
    330299                  ! compute volumic mass pure water at atm pressure 
     
    366335         END DO                                           !   End of slab 
    367336         !                                                ! =============== 
    368  
    369  
     337         ! 
    370338      CASE ( 1 )               ! Linear formulation function of temperature only 
    371  
     339         ! 
    372340         !                                                ! =============== 
    373341         DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    385353         END DO                                           !   End of slab 
    386354         !                                                ! =============== 
    387  
    388  
     355         ! 
    389356      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    390  
     357         ! 
    391358         !                                                ! =============== 
    392359         DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    404371         END DO                                           !   End of slab 
    405372         !                                                ! =============== 
    406  
     373         ! 
    407374      CASE DEFAULT 
    408  
     375         ! 
    409376         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    410377         CALL ctl_stop( ctmp1 ) 
    411  
     378         ! 
    412379      END SELECT 
    413  
    414       IF(ln_ctl)   THEN 
    415          CALL prt_ctl(tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk) 
    416       ENDIF 
    417  
     380      ! 
     381      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
     382      ! 
    418383   END SUBROUTINE eos_insitu_pot 
    419384 
    420    SUBROUTINE eos_insitu_2d ( ptem, psal, pdep, prd ) 
     385 
     386   SUBROUTINE eos_insitu_2d( ptem, psal, pdep, prd ) 
    421387      !!---------------------------------------------------------------------- 
    422388      !!                  ***  ROUTINE eos_insitu_2d  *** 
     
    452418      !! ** Action  : - prd , the in situ density (no units) 
    453419      !! 
    454       !! References : 
    455       !!      Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994 
    456       !! 
    457       !! History : 
    458       !!   8.5  !  02-11  (G. Madec, A. Bozec)  partial step 
    459       !!---------------------------------------------------------------------- 
    460       !! * Arguments 
    461       REAL(wp), DIMENSION(jpi,jpj), INTENT( in ) ::   & 
    462          ptem,                           &  ! potential temperature 
    463          psal,                           &  ! salinity 
    464          pdep                               ! depth 
    465       REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::   & 
    466          prd                                ! potential density (surface referenced) 
    467  
    468       !! * Local declarations 
    469       INTEGER ::  ji, jj                    ! dummy loop indices 
     420      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
     421      !!---------------------------------------------------------------------- 
     422      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ptem   ! potential temperature  [Celcius] 
     423      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity               [psu] 
     424      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pdep   ! depth                  [m] 
     425      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   prd    ! in situ density  
     426      !! 
     427      INTEGER  ::  ji, jj                    ! dummy loop indices 
    470428      REAL(wp) ::   &             ! temporary scalars 
    471429         zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw,   & 
    472430         zb, zd, zc, zaw, za, zb1, za1, zkw, zk0,               & 
    473431         zmask 
    474       REAL(wp), DIMENSION(jpi,jpj) :: zws 
    475       !!---------------------------------------------------------------------- 
    476  
    477  
    478       ! initialization (in not already done) 
    479       IF( neos_init == 0 ) CALL eos_init 
     432      REAL(wp), DIMENSION(jpi,jpj) ::   zws 
     433      !!---------------------------------------------------------------------- 
     434 
     435      IF( neos_init == 0 ) CALL eos_init      ! initialization (in not already done) 
    480436 
    481437      prd(:,:) = 0.e0 
    482438 
    483439      SELECT CASE ( neos ) 
    484  
     440      ! 
    485441      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    486  
     442      ! 
    487443!CDIR NOVERRCHK 
    488444         DO jj = 1, jpjm1 
     
    496452            END DO 
    497453         END DO 
    498  
    499454         !                                                ! =============== 
    500455         DO jj = 1, jpjm1                                 ! Horizontal slab 
     
    505460            DO ji = 1, fs_jpim1   ! vector opt. 
    506461#endif 
    507  
    508462               zmask = tmask(ji,jj,1)      ! land/sea bottom mask = surf. mask 
    509463 
     
    543497               ! masked in situ density anomaly 
    544498               prd(ji,jj) = ( zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 )   & 
    545                           / rau0 * zmask 
    546             END DO 
    547             !                                             ! =============== 
    548          END DO                                           !   End of slab 
    549          !                                                ! =============== 
    550  
    551  
     499                  &       / rau0 * zmask 
     500            END DO 
     501            !                                             ! =============== 
     502         END DO                                           !   End of slab 
     503         !                                                ! =============== 
     504         ! 
    552505      CASE ( 1 )               ! Linear formulation function of temperature only 
    553  
     506         ! 
    554507         !                                                ! =============== 
    555508         DO jj = 1, jpjm1                                 ! Horizontal slab 
     
    565518         END DO                                           !   End of slab 
    566519         !                                                ! =============== 
    567  
    568  
     520         ! 
    569521      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    570  
     522         ! 
    571523         !                                                ! =============== 
    572524         DO jj = 1, jpjm1                                 ! Horizontal slab 
     
    582534         END DO                                           !   End of slab 
    583535         !                                                ! =============== 
    584  
     536         ! 
    585537      CASE DEFAULT 
    586  
     538         ! 
    587539         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    588540         CALL ctl_stop( ctmp1 ) 
    589  
     541         ! 
    590542      END SELECT 
    591543 
    592       IF(ln_ctl)   CALL prt_ctl(tab2d_1=prd, clinfo1=' eos2d: ') 
    593  
     544      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
     545      ! 
    594546   END SUBROUTINE eos_insitu_2d 
    595547 
     
    623575      !! ** Action  : - pn2 : the brunt-vaisala frequency 
    624576      !! 
    625       !! References : 
    626       !!      McDougall, T. J., J. Phys. Oceanogr., 17, 1950-1964, 1987. 
    627       !! 
    628       !! History : 
    629       !!   6.0  !  94-07  (G. Madec, M. Imbard)  Original code 
    630       !!   8.0  !  97-07  (G. Madec) introduction of statement functions 
    631       !!   8.5  !  02-07  (G. Madec) Free form, F90 
    632       !!   8.5  !  02-08  (G. Madec) introduction of arguments 
    633       !!---------------------------------------------------------------------- 
    634       !! * Arguments 
    635       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   & 
    636          ptem,                           &  ! potential temperature 
    637          psal                               ! salinity 
    638       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   & 
    639          pn2                               ! Brunt-Vaisala frequency 
    640  
    641       !! * Local declarations 
     577      !! References :   McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987. 
     578      !!---------------------------------------------------------------------- 
     579      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptem   ! potential temperature   [Celcius] 
     580      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   psal   ! salinity                [psu] 
     581      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pn2    ! Brunt-Vaisala frequency [s-1] 
     582 
    642583      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    643       REAL(wp) ::   & 
    644          zgde3w, zt, zs, zh,  &  ! temporary scalars  
    645          zalbet, zbeta           !    "         " 
     584      REAL(wp) ::   zgde3w, zt, zs, zh,  &  ! temporary scalars  
     585         &          zalbet, zbeta           !    "         " 
    646586#if defined key_zdfddm 
    647587      REAL(wp) ::   zds          ! temporary scalars 
    648588#endif 
    649589      !!---------------------------------------------------------------------- 
    650       !!  OPA8.5, LODYC-IPSL (2002) 
    651       !!---------------------------------------------------------------------- 
    652590 
    653591      ! pn2 : first and last levels 
     
    660598 
    661599      SELECT CASE ( neos ) 
    662  
     600      ! 
    663601      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    664  
     602         ! 
    665603         !                                                ! =============== 
    666604         DO jk = 2, jpkm1                                 ! Horizontal slab 
     
    712650         END DO                                           !   End of slab 
    713651         !                                                ! =============== 
    714  
    715  
     652         ! 
    716653      CASE ( 1 )               ! Linear formulation function of temperature only 
    717  
     654         ! 
    718655         !                                                ! =============== 
    719656         DO jk = 2, jpkm1                                 ! Horizontal slab 
     
    728665         END DO                                           !   End of slab 
    729666         !                                                ! =============== 
    730  
    731  
     667         ! 
    732668      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    733  
     669         ! 
    734670         !                                                ! =============== 
    735671         DO jk = 2, jpkm1                                 ! Horizontal slab 
     
    756692         END DO                                           !   End of slab 
    757693         !                                                ! =============== 
    758  
     694         ! 
    759695      CASE DEFAULT 
    760  
     696         ! 
    761697         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    762698         CALL ctl_stop( ctmp1 ) 
    763  
     699         ! 
    764700      END SELECT 
    765701 
    766       IF(ln_ctl)   THEN 
    767          CALL prt_ctl(tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk) 
     702      IF(ln_ctl)   CALL prt_ctl(tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk) 
    768703#if defined key_zdfddm 
    769          CALL prt_ctl(tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk) 
     704      IF(ln_ctl)   CALL prt_ctl(tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk) 
    770705#endif 
    771       ENDIF 
    772  
     706      ! 
    773707   END SUBROUTINE eos_bn2 
    774708 
    775709 
     710   FUNCTION tfreez( psal ) RESULT( ptf ) 
     711      !!---------------------------------------------------------------------- 
     712      !!                 ***  ROUTINE eos_init  *** 
     713      !! 
     714      !! ** Purpose :   Compute the sea surface freezing temperature [Celcius] 
     715      !! 
     716      !! ** Method  :   UNESCO freezing point at the surface (pressure = 0???) 
     717      !!       freezing point [Celcius]=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p 
     718      !!       checkvalue: tf= -2.588567 Celsius for s=40.0psu, p=500. decibars 
     719      !! 
     720      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978 
     721      !!---------------------------------------------------------------------- 
     722      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu] 
     723      REAL(wp), DIMENSION(jpi,jpj)                ::   ptf    ! freezing temperature [Celcius] 
     724      !!---------------------------------------------------------------------- 
     725      ptf(:,:) = ( - 0.0575 + 1.710523e-3 * SQRT( psal(:,:) )   & 
     726         &                  - 2.154996e-4 *       psal(:,:)   ) * psal(:,:) 
     727   END FUNCTION tfreez 
     728 
     729 
    776730   SUBROUTINE eos_init 
    777731      !!---------------------------------------------------------------------- 
     
    780734      !! ** Purpose :   initializations for the equation of state 
    781735      !! 
    782       !! ** Method  :   Read the namelist nameos 
    783       !! 
    784       !! ** Action  :   blahblah.... 
    785       !! 
    786       !! History : 
    787       !!   8.5  !  02-10  (G. Madec)  Original code 
    788       !!---------------------------------------------------------------------- 
    789       NAMELIST/nameos/ neos, ralpha, rbeta 
    790       !!---------------------------------------------------------------------- 
    791       !!  OPA 8.5, LODYC-IPSL (2002) 
    792       !!---------------------------------------------------------------------- 
    793  
    794       ! set the initialization flag to 1 
    795       neos_init = 1           ! indicate that the initialization has been done 
    796  
    797       ! namelist nameos : ocean physical parameters 
    798  
    799       ! Read Namelist nameos : equation of state 
    800       REWIND( numnam ) 
     736      !! ** Method  :   Read the namelist nameos and control the parameters 
     737      !!---------------------------------------------------------------------- 
     738 
     739      neos_init = 1               ! indicate that the initialization has been done 
     740 
     741      REWIND( numnam )            ! Read Namelist nameos : equation of state 
    801742      READ  ( numnam, nameos ) 
    802743 
     
    807748         WRITE(numout,*) '~~~~~~~~' 
    808749         WRITE(numout,*) '          Namelist nameos : set eos parameters' 
    809          WRITE(numout,*) 
    810750         WRITE(numout,*) '             flag for eq. of state and N^2  neos   = ', neos 
    811751         WRITE(numout,*) '             thermal exp. coef. (linear)    ralpha = ', ralpha 
    812752         WRITE(numout,*) '             saline  exp. coef. (linear)    rbeta  = ', rbeta 
    813          WRITE(numout,*) 
    814753      ENDIF 
    815754 
     
    817756 
    818757      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    819  
     758         IF(lwp) WRITE(numout,*) 
    820759         IF(lwp) WRITE(numout,*) '          use of Jackett & McDougall (1994) equation of state and' 
    821760         IF(lwp) WRITE(numout,*) '                 McDougall (1987) Brunt-Vaisala frequency' 
    822  
     761         ! 
    823762      CASE ( 1 )               ! Linear formulation function of temperature only 
    824  
     763         IF(lwp) WRITE(numout,*) 
    825764         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - ralpha * T )' 
    826765         IF( lk_zdfddm ) CALL ctl_stop( '          double diffusive mixing parameterization requires',   & 
    827766              &                         ' that T and S are used as state variables' ) 
    828  
     767         ! 
    829768      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    830  
     769         IF(lwp) WRITE(numout,*) 
    831770         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )' 
    832  
    833       CASE DEFAULT 
    834  
     771         ! 
     772      CASE DEFAULT             ! E R R O R in neos  
    835773         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    836774         CALL ctl_stop( ctmp1 ) 
    837  
    838775      END SELECT 
    839776 
  • trunk/NEMO/OPA_SRC/phycst.F90

    r699 r703  
    44   !!     Definition of of both ocean and ice parameters used in the code 
    55   !!===================================================================== 
    6    !! * Modules used 
     6   !! History :        !  90-10  (C. Levy - G. Madec)  Original code 
     7   !!                  !  91-11  (G. Madec) 
     8   !!                  !  91-12  (M. Imbard) 
     9   !!             8.5  !  02-08  (G. Madec, C. Ethe)  F90, add ice constants 
     10   !!             9.0  !  06-08  (G. Madec)  style  
     11   !!---------------------------------------------------------------------- 
     12 
     13   !!---------------------------------------------------------------------- 
     14   !!   phy_cst  : define and print physical constant and domain parameters 
     15   !!---------------------------------------------------------------------- 
    716   USE par_oce          ! ocean parameters 
    817   USE in_out_manager   ! I/O manager 
     
    1120   PRIVATE 
    1221 
    13    !! * Routine accessibility 
    14    PUBLIC phy_cst          ! routine called by inipar.F90 
     22   PUBLIC   phy_cst     ! routine called by inipar.F90 
    1523 
    16    !! * Shared module variables 
    17    INTEGER, PUBLIC, DIMENSION(12) ::   &  !: 
    18       nbiss = (/ 31, 29, 31, 30, 31, 30,      &  !: number of days per month 
    19          &       31, 31, 30, 31, 30, 31 /) ,  &  !  (leap-year) 
    20       nobis = (/ 31, 28, 31, 30, 31, 30,      &  !: number of days per month 
    21          &       31, 31, 30, 31, 30, 31 /)       !  (365 days a year) 
    22     
    23    REAL(wp), PUBLIC ::                        &  !: 
    24       rpi = 3.141592653589793_wp           ,  &  !: pi 
    25       rad = 3.141592653589793_wp / 180._wp ,  &  !: conversion from degre into radian 
    26       rsmall = 0.5 * EPSILON( 1. )               !: smallest real computer value 
     24   REAL(wp), PUBLIC ::   rpi = 3.141592653589793_wp             !: pi 
     25   REAL(wp), PUBLIC ::   rad = 3.141592653589793_wp / 180._wp   !: conversion from degre into radian 
     26   REAL(wp), PUBLIC ::   rsmall = 0.5 * EPSILON( 1. )           !: smallest real computer value 
    2727    
    2828   REAL(wp), PUBLIC ::          & !: 
     
    6161      xlic    = 300.33e+6_wp  ,   &  !: volumetric latent heat fusion of ice 
    6262      xsn     =   2.8e+6      ,   &  !: latent heat of sublimation of snow 
    63       rhoic   = 900._wp       ,   &  !: density of sea ice (kg/m3) 
    64       rhosn   = 330._wp       ,   &  !: density of snow (kg/m3) 
     63      rhoic   = 900._wp       ,   &  !: volumic mass of sea ice (kg/m3) 
     64      rhosn   = 330._wp       ,   &  !: volumic mass of snow (kg/m3) 
    6565      emic    =   0.97_wp     ,   &  !: emissivity of snow or ice 
    6666      sice    =   6.0_wp      ,   &  !: salinity of ice (psu) 
     
    7070      vkarmn  =   0.4_wp      ,   &  !: von Karman constant 
    7171      stefan  =   5.67e-8_wp         !: Stefan-Boltzmann constant  
    72       !!---------------------------------------------------------------------- 
    73       !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    74       !! $Id$ 
    75       !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    76       !!---------------------------------------------------------------------- 
     72 
     73   !!---------------------------------------------------------------------- 
     74   !!  OPA 9.0 , LOCEAN-IPSL (2006)  
     75   !! $Id$ 
     76   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     77   !!---------------------------------------------------------------------- 
    7778    
    7879CONTAINS 
     
    8384      !! 
    8485      !! ** Purpose :   Print model parameters and set and print the constants 
    85       !! 
    86       !! ** Method  :   no 
    87       !! 
    88       !! History : 
    89       !!        !  90-10  (C. Levy - G. Madec)  Original code 
    90       !!        !  91-11  (G. Madec) 
    91       !!        !  91-12  (M. Imbard) 
    92       !!   8.5  !  02-08  (G. Madec, C. Ethe)  F90, add ice constants  
    9386      !!---------------------------------------------------------------------- 
    94       !! * Local variables 
    95       CHARACTER (len=64) ::   cform = "(A9, 3(A13, I7) )"  
     87      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7) )"  
    9688      !!---------------------------------------------------------------------- 
    9789 
     
    10395      ! ---------------- 
    10496      IF(lwp) THEN 
    105          WRITE(numout,*) '       parameter file' 
    106          WRITE(numout,*) 
     97         WRITE(numout,*) '       Domain info' 
    10798         WRITE(numout,*) '          dimension of model' 
    108          WRITE(numout,*) '              Local domain      Global domain       Data domain ' 
    109          WRITE(numout,cform) '         ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo, '   jpidta  : ', jpidta 
    110          WRITE(numout,cform) '         ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo, '   jpjdta  : ', jpjdta 
    111          WRITE(numout,cform) '         ','   jpk     : ', jpk, '   jpk     : ', jpk   , '   jpkdta  : ', jpkdta 
    112          WRITE(numout,*)      '        ','   jpij    : ', jpij 
    113          WRITE(numout,*) 
     99         WRITE(numout,*) '                 Local domain      Global domain       Data domain ' 
     100         WRITE(numout,cform) '            ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo, '   jpidta  : ', jpidta 
     101         WRITE(numout,cform) '            ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo, '   jpjdta  : ', jpjdta 
     102         WRITE(numout,cform) '            ','   jpk     : ', jpk, '   jpk     : ', jpk   , '   jpkdta  : ', jpkdta 
     103         WRITE(numout,*)      '           ','   jpij    : ', jpij 
    114104         WRITE(numout,*) '          mpp local domain info (mpp)' 
    115105         WRITE(numout,*) '             jpni    : ', jpni, '   jpreci  : ', jpreci 
    116106         WRITE(numout,*) '             jpnj    : ', jpnj, '   jprecj  : ', jprecj 
    117107         WRITE(numout,*) '             jpnij   : ', jpnij 
    118  
    119          WRITE(numout,*) 
    120108         WRITE(numout,*) '          lateral domain boundary condition type : jperio  = ', jperio 
    121          WRITE(numout,*) '          domain island (use in rigid-lid case)  : jpisl   = ', jpisl  
    122          WRITE(numout,*) '                                                   jpnisl  = ', jpnisl 
     109         WRITE(numout,*) '          domain island (use in rigid-lid case)  : jpisl   = ', jpisl, '   jpnisl  = ', jpnisl 
    123110      ENDIF 
    124111 
     
    126113      ! ---------------- 
    127114      IF(lwp) WRITE(numout,*) 
    128       IF(lwp) WRITE(numout,*) '       constants' 
     115      IF(lwp) WRITE(numout,*) '       Constants' 
    129116 
    130117      IF(lwp) WRITE(numout,*) 
  • trunk/NEMO/OPA_SRC/step.F90

    r699 r703  
    44   !! Time-stepping    : manager of the ocean, tracer and ice time stepping 
    55   !!====================================================================== 
    6    !! History :        !  91-03  ()  Original code 
    7    !!                  !  91-11  (G. Madec) 
     6   !! History :        !  91-03  (G. Madec)  Original code 
    87   !!                  !  92-06  (M. Imbard)  add a first output record 
    98   !!                  !  96-04  (G. Madec)  introduction of dynspg 
     
    2019   !!             " "  !  06-01  (L. Debreu, C. Mazauric)  Agrif implementation 
    2120   !!             " "  !  06-07  (S. Masson)  restart using iom 
     21   !!             " "  !  06-08  (G. Madec)  surface module  
     22   !!---------------------------------------------------------------------- 
     23 
    2224   !!---------------------------------------------------------------------- 
    2325   !!   stp            : OPA system time-stepping 
     
    3032   USE cpl_oce         ! coupled ocean-atmosphere variables 
    3133   USE in_out_manager  ! I/O manager 
    32    USE iom 
     34   USE iom             ! 
    3335   USE lbclnk 
    3436 
     
    3739   USE dtatem          ! ocean temperature data           (dta_tem routine) 
    3840   USE dtasal          ! ocean salinity    data           (dta_sal routine) 
    39    USE dtasst          ! ocean sea surface temperature    (dta_sst routine) 
    40    USE dtasss          ! ocean sea surface salinity       (dta_sss routine) 
    41    USE taumod          ! surface stress                   (tau     routine) 
    42    USE flxmod          ! thermohaline fluxes              (flx     routine) 
    43    USE ocesbc          ! thermohaline fluxes              (oce_sbc routine) 
    44    USE flxrnf          ! runoffs                          (flx_rnf routine) 
    45    USE flxfwb          ! freshwater budget correction     (flx_fwb routine) 
    46    USE closea          ! closed sea freshwater budget     (flx_clo routine) 
     41   USE sbcmod          ! surface boundary condition       (sbc     routine) 
     42   USE sbcrnf          ! surface boundary condition: runoff variables 
    4743   USE ocfzpt          ! surface ocean freezing point    (oc_fz_pt routine) 
    4844 
     
    161157      !!              -8- Outputs and diagnostics 
    162158      !!---------------------------------------------------------------------- 
    163       !! * Arguments 
    164159#if defined key_agrif    
    165       INTEGER               :: kstp   ! ocean time-step index 
     160      INTEGER             ::  kstp   ! ocean time-step index 
    166161#else 
    167       INTEGER, INTENT( in ) :: kstp   ! ocean time-step index 
     162      INTEGER, INTENT(in) ::  kstp   ! ocean time-step index 
    168163#endif       
    169  
    170       !! * local declarations 
     164      INTEGER ::   jk       ! dummy loop indice 
    171165      INTEGER ::   indic    ! error indicator if < 0 
    172166      !! --------------------------------------------------------------------- 
     
    179173      indic = 1                    ! reset to no error condition 
    180174 
     175!!gm: attention n'est plus ds le step de gm 
    181176      adatrj = adatrj + rdt/86400._wp 
     177!!gm: attention n'est plus ds le step de gm 
    182178 
    183179      CALL day( kstp )             ! Calendar 
     
    186182 
    187183      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    188       ! Update data, open boundaries and Forcings 
     184      ! Update data, open boundaries, surface boundary condition (including sea-ice) 
    189185      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    190186 
    191187      IF( lk_dtatem  )   CALL dta_tem( kstp )         ! update 3D temperature data 
    192  
    193       IF( lk_dtasal  )   CALL dta_sal( kstp )         ! Salinity data 
    194  
    195       IF( lk_dtasst  )   CALL dta_sst( kstp )         ! Sea Surface Temperature data 
    196  
    197       IF( lk_dtasss  )   CALL dta_sss( kstp )         ! Sea Surface Salinity data 
     188      IF( lk_dtasal  )   CALL dta_sal( kstp )         ! update 3D salinity data 
     189 
     190                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
    198191 
    199192      IF( lk_obc     )   CALL obc_dta( kstp )         ! update dynamic and tracer data at open boundaries 
    200  
    201193      IF( lk_obc     )   CALL obc_rad( kstp )         ! compute phase velocities at open boundaries 
    202194 
    203       IF( .NOT. lk_core )    CALL tau( kstp )         ! wind stress 
    204  
    205                          CALL flx_rnf( kstp )         ! runoff data 
    206  
    207                          CALL flx( kstp )             ! heat and freshwater fluxes 
    208  
    209       IF( lk_ice_lim )   CALL ice_stp( kstp )         ! sea-ice model (Update stress & fluxes) 
    210  
    211                          CALL oce_sbc( kstp )         ! ocean surface boudaries 
    212  
    213       IF( ln_fwb     )   CALL flx_fwb( kstp )         ! freshwater budget 
    214  
    215       IF( nclosea == 1 ) CALL flx_clo( kstp )         ! closed sea in the domain (update freshwater fluxes) 
    216  
    217       IF( kstp == nit000 ) THEN  
    218          IF( ninist == 1 ) THEN                       ! Output the initial state and forcings 
    219             CALL dia_wri_state( 'output.init' ) 
    220          ENDIF 
    221       ENDIF 
    222  
    223       IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
    224          CALL prt_ctl(tab2d_1=emp    , clinfo1=' emp  -   : ', mask1=tmask, ovlap=1) 
    225          CALL prt_ctl(tab2d_1=emps   , clinfo1=' emps -   : ', mask1=tmask, ovlap=1) 
    226          CALL prt_ctl(tab2d_1=qt     , clinfo1=' qt   -   : ', mask1=tmask, ovlap=1) 
    227          CALL prt_ctl(tab2d_1=qsr    , clinfo1=' qsr  -   : ', mask1=tmask, ovlap=1) 
    228          CALL prt_ctl(tab2d_1=runoff , clinfo1=' runoff   : ', mask1=tmask, ovlap=1) 
    229          CALL prt_ctl(tab3d_1=tmask  , clinfo1=' tmask    : ', mask1=tmask, ovlap=1, kdim=jpk) 
    230          CALL prt_ctl(tab3d_1=tn     , clinfo1=' sst  -   : ', mask1=tmask, ovlap=1, kdim=1) 
    231          CALL prt_ctl(tab3d_1=sn     , clinfo1=' sss  -   : ', mask1=tmask, ovlap=1, kdim=1) 
    232          CALL prt_ctl(tab2d_1=taux   , clinfo1=' tau  - x : ', mask1=umask, & 
    233             &         tab2d_2=tauy   , clinfo2='      - y : ', mask2=vmask,ovlap=1) 
     195      IF( ninist == 1 ) THEN                       ! Output the initial state and forcings 
     196                        CALL dia_wri_state( 'output.init' ) 
     197                        ninist = 0 
    234198      ENDIF 
    235199 
     
    244208      !----------------------------------------------------------------------- 
    245209 
    246                        CALL bn2( tb, sb, rn2 )              ! before Brunt-Vaisala frequency 
     210                        CALL bn2( tb, sb, rn2 )              ! before Brunt-Vaisala frequency 
    247211       
    248212      !                                                     ! Vertical eddy viscosity and diffusivity coefficients 
     
    261225      ENDIF 
    262226 
    263       IF( cp_cfg == "orca" ) THEN                           ! ORCA: Reduce vertical mixing in some specific areas 
    264          SELECT CASE ( jp_cfg ) 
    265             CASE ( 05 )                         ! ORCA R2 configuration 
    266                avt  (:,:,2) = avt  (:,:,2) + 1.e-3 * upsrnfh(:,:)   ! increase diffusivity of rivers mouths 
    267             CASE ( 025 )                         ! ORCA R025 configuration 
    268                avt  (:,:,2) = avt  (:,:,2) + 2.e-3 * upsrnfh(:,:)   ! increase diffusivity of rivers mouths 
    269          END SELECT 
     227      IF( nn_runoff /=0 ) THEN                              ! increase diffusivity at rivers mouths 
     228         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + rn_avt_rnf * rnfmsk(:,:)   ;   END DO 
    270229      ENDIF 
    271230 
    272231      IF( ln_zdfevd )   CALL zdf_evd( kstp )                 ! enhanced vertical eddy diffusivity 
    273232 
    274       IF( lk_zdfddm .AND. .NOT. lk_zdfkpp)   & 
     233      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   & 
    275234         &              CALL zdf_ddm( kstp )                 ! double diffusive mixing 
    276235 
     
    285244      ! N.B. ua, va, ta, sa arrays are used as workspace in this section 
    286245      !----------------------------------------------------------------------- 
    287  
    288246      IF( lk_ldfslp     )   CALL ldf_slp( kstp, rhd, rn2 )       ! before slope of the lateral mixing 
    289  
    290247#if defined key_traldf_c2d 
    291248      IF( lk_traldf_eiv )   CALL ldf_eiv( kstp )                 ! eddy induced velocity coefficient 
    292249#endif 
    293250 
    294  
    295251#if defined key_passivetrc 
    296252      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     
    299255      ! N.B. ua, va, ta, sa arrays are used as workspace in this section 
    300256      !----------------------------------------------------------------------- 
    301  
    302257                             CALL trc_stp( kstp, indic )            ! time-stepping 
    303  
    304 #endif 
    305  
     258#endif 
    306259 
    307260      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     
    310263      ! N.B. ua, va arrays are used as workspace in this section 
    311264      !----------------------------------------------------------------------- 
    312  
    313265                             ta(:,:,:) = 0.e0               ! set tracer trends to zero 
    314266                             sa(:,:,:) = 0.e0 
    315267 
    316268                             CALL tra_sbc    ( kstp )       ! surface boundary condition 
    317  
    318269      IF( ln_traqsr      )   CALL tra_qsr    ( kstp )       ! penetrative solar radiation qsr 
    319  
    320270      IF( lk_trabbc      )   CALL tra_bbc    ( kstp )       ! bottom heat flux 
    321  
    322271      IF( lk_trabbl_dif  )   CALL tra_bbl_dif( kstp )       ! diffusive bottom boundary layer scheme 
    323272      IF( lk_trabbl_adv  )   CALL tra_bbl_adv( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme 
    324  
    325273      IF( lk_tradmp      )   CALL tra_dmp    ( kstp )       ! internal damping trends 
    326  
    327274                             CALL tra_adv    ( kstp )       ! horizontal & vertical advection 
    328  
    329275      IF( n_cla == 1     )   CALL tra_cla    ( kstp )       ! Cross Land Advection (Update Hor. advection) 
    330  
    331276      IF( lk_zdfkpp )        CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes 
    332  
    333277                             CALL tra_ldf    ( kstp )       ! lateral mixing 
    334278#if defined key_agrif 
     
    336280#endif 
    337281                             CALL tra_zdf    ( kstp )       ! vertical mixing 
    338  
    339282                             CALL tra_nxt( kstp )           ! tracer fields at next time step 
    340  
    341283      IF( ln_zdfnpc      )   CALL tra_npc( kstp )           ! update the new (t,s) fields by non 
    342284      !                                                     ! penetrative convective adjustment 
     
    359301      ! N.B. ta, sa arrays are used as workspace in this section  
    360302      !----------------------------------------------------------------------- 
    361  
    362  
    363303                               ua(:,:,:) = 0.e0               ! set dynamics trends to zero 
    364304                               va(:,:,:) = 0.e0 
    365305 
    366306                               CALL dyn_adv( kstp )           ! advection (vector or flux form) 
    367  
    368307                               CALL dyn_vor( kstp )           ! vorticity term including Coriolis 
    369  
    370308                               CALL dyn_ldf( kstp )           ! lateral mixing 
    371309#if defined key_agrif 
     
    373311#endif 
    374312                               CALL dyn_hpg( kstp )           ! horizontal gradient of Hydrostatic pressure 
    375  
    376313                               CALL dyn_zdf( kstp )           ! vertical diffusion 
    377  
    378314      IF( lk_dynspg_rl ) THEN 
    379315         IF( lk_obc    )       CALL obc_spg( kstp )           ! surface pressure gradient at open boundaries 
    380316      ENDIF 
    381                        indic=0 
    382 !i bug lbc sur emp 
    383       CALL lbc_lnk( emp, 'T', 1. ) 
    384 !i 
     317                               indic=0 
    385318                               CALL dyn_spg( kstp, indic )    ! surface pressure gradient 
    386  
    387319                               CALL dyn_nxt( kstp )           ! lateral velocity at next time step 
    388  
    389320      IF( lk_vvl )             CALL dom_vvl                   ! vertical mesh at next time step 
    390321 
     
    395326      ! N.B. ua, va, ta, sa arrays are used as workspace in this section 
    396327      !----------------------------------------------------------------------- 
    397  
    398328                       CALL oc_fz_pt                        ! ocean surface freezing temperature 
    399  
    400329                       CALL div_cur( kstp )                 ! Horizontal divergence & Relative vorticity 
    401  
    402330      IF( n_cla == 1 ) CALL div_cla( kstp )                 ! Cross Land Advection (Update Hor. divergence) 
    403  
    404331                       CALL wzv( kstp )                     ! Vertical velocity 
    405332 
    406  
    407  
    408       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    409       ! Control, and restarts 
    410       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    411       ! N.B. ua, va, ta, sa arrays are used as workspace in this section 
    412       !----------------------------------------------------------------------- 
    413       !                                                     ! Time loop: control and print 
     333      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     334      ! Control and restarts 
     335      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    414336                                 CALL stp_ctl( kstp, indic ) 
    415337      IF( indic < 0          )   CALL ctl_stop( 'step: indic < 0' ) 
    416  
    417338      IF( kstp == nit000     )   CALL iom_close( numror )             ! close input  ocean restart file 
    418339      IF( lrst_oce           )   CALL rst_write  ( kstp )             ! write output ocean restart file 
     
    425346      !----------------------------------------------------------------------- 
    426347 
    427       IF ( nstop == 0 ) THEN                                ! Diagnostics 
     348      IF( nstop == 0 ) THEN                                 ! Diagnostics: 
    428349         IF( lk_floats  )   CALL flo_stp( kstp )                 ! drifting Floats 
    429350         IF( lk_trddyn  )   CALL trd_dwr( kstp )                 ! trends: dynamics  
     
    437358         IF( lk_diafwb  )   CALL dia_fwb( kstp )                 ! Fresh water budget diagnostics 
    438359         IF( ln_diaptr  )   CALL dia_ptr( kstp )                 ! Poleward TRansports diagnostics 
    439  
    440          !                                                 ! Outputs 
    441                             CALL dia_wri    ( kstp, indic )      ! ocean model: outputs 
     360         !                                                 ! outputs 
     361                            CALL dia_wri( kstp, indic )          ! ocean model: outputs 
    442362      ENDIF 
    443363 
Note: See TracChangeset for help on using the changeset viewer.