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

Changeset 88


Ignore:
Timestamp:
2004-04-22T15:50:27+02:00 (20 years ago)
Author:
opalod
Message:

CT : UPDATE057 : # General syntax, alignement, comments corrections

# l_ctl alone replace the set (l_ctl .AND. lwp)
# Add of diagnostics which are activated when using l_ctl logical

Location:
trunk/NEMO
Files:
21 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/LIM_SRC/ice.F90

    r12 r88  
    3131      resl   = 5.0e-05,  &  !: maximum value for the residual of relaxation 
    3232      cw     = 5.0e-03,  &  !: drag coefficient for oceanic stress 
    33       angvg  = 0.0    ,  &  !: turning angle for oceanic stress 
     33      angvg  = 0.e0   ,  &  !: turning angle for oceanic stress 
    3434      pstar  = 1.0e+04,  &  !: first bulk-rheology parameter 
    35       c_rhg  = 20.0   ,  &  !: second bulk-rhelogy parameter 
    36       etamn  = 0.0e+07,  &  !: minimun value for viscosity 
    37       creepl = 2.0e-08,  &  !: creep limit 
    38       ecc    = 2.0    ,  &  !: eccentricity of the elliptical yield curve 
     35      c_rhg  = 20.e0  ,  &  !: second bulk-rhelogy parameter 
     36      etamn  = 0.e+07,   &  !: minimun value for viscosity 
     37      creepl = 2.e-08,   &  !: creep limit 
     38      ecc    = 2.e0   ,  &  !: eccentricity of the elliptical yield curve 
    3939      ahi0   = 350.e0       !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
    4040 
    … …  
    9898      tio_u, tio_v       !: two components of the ice-ocean stress (N/m2) 
    9999 
    100    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,nsmax) ::   &  !: 
     100   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpsmax) ::   &  !: 
    101101      scal0              !: ??? 
    102102 
    103    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,nlayersp1) ::   &  !: 
     103   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jplayersp1) ::   &  !: 
    104104      tbif          !: Temperature inside the ice/snow layer 
    105105 
    106    REAL(wp), DIMENSION(jpi,jpj,0:kmax+1) ::    &  !: 
     106   REAL(wp), DIMENSION(jpi,jpj,0:jpkmax+1) ::    &  !: 
    107107      reslum        !: Relative absorption of solar radiation in each ocean level 
    108108 

  • trunk/NEMO/LIM_SRC/icestp.F90

    r3 r88  
    1616   USE flx_oce         ! forcings variables 
    1717   USE dom_ice 
     18   USE cpl_oce 
    1819   USE daymod 
    1920   USE phycst          ! Define parameters for the routines 
    … …  
    7677 
    7778      IF( kt == nit000 ) THEN 
    78 # if defined key_coupled 
    79          IF(lwp) WRITE(numout,*) 
    80          IF(lwp) WRITE(numout,*) 'ice_stp : Louvain la Neuve Ice Model (LIM)' 
    81          IF(lwp) WRITE(numout,*) '~~~~~~~   coupled case' 
    82 #else 
    83          IF(lwp) WRITE(numout,*) 
    84          IF(lwp) WRITE(numout,*) 'ice_stp : Louvain la Neuve Ice Model (LIM)'  
    85          IF(lwp) WRITE(numout,*) '~~~~~~~   forced case using bulk formulea' 
    86 #endif 
     79         IF( lk_cpl ) THEN 
     80            IF(lwp) WRITE(numout,*) 
     81            IF(lwp) WRITE(numout,*) 'ice_stp : Louvain la Neuve Ice Model (LIM)' 
     82            IF(lwp) WRITE(numout,*) '~~~~~~~   coupled case' 
     83         ELSE 
     84            IF(lwp) WRITE(numout,*) 
     85            IF(lwp) WRITE(numout,*) 'ice_stp : Louvain la Neuve Ice Model (LIM)'  
     86            IF(lwp) WRITE(numout,*) '~~~~~~~   forced case using bulk formulea' 
     87         ENDIF 
    8788         !  Initialize fluxes fields 
    8889         gtaux(:,:) = 0.e0 
    … …  
    183184          
    184185 
    185          IF( l_ctl .AND. lwp ) THEN         ! print mean trends (used for debugging) 
     186         IF( l_ctl ) THEN         ! print mean trends (used for debugging) 
    186187            WRITE(numout,*) 'Ice Forcings ' 
    187188            WRITE(numout,*) ' qsr_oce  : ', SUM( qsr_oce (:,:) ), ' qsr_ice  : ', SUM( qsr_ice (:,:) ) 
    … …  
    202203         CALL lim_dyn                                                ! Ice dynamics !   ( rheology/dynamics ) 
    203204         !                                                           !--------------! 
    204          IF( l_ctl .AND. lwp ) THEN 
     205         IF( l_ctl ) THEN 
    205206            WRITE(numout,*) ' hsnif  2 : ', SUM( hsnif  (:,:) ), ' hicnif   : ', SUM( hicif  (:,:) ) 
    206207            WRITE(numout,*) ' frld   2 : ', SUM( frld   (:,:) ), ' sist     : ', SUM( sist   (:,:) ) 
    … …  
    211212         CALL lim_trp                                                ! Ice transport !  ( Advection/diffusion ) 
    212213         !                                                           !---------------! 
    213          IF( l_ctl .AND. lwp ) THEN 
     214         IF( l_ctl ) THEN 
    214215            WRITE(numout,*) ' hsnif  3 : ', SUM( hsnif  (:,:) ), ' hicnif   : ', SUM( hicif  (:,:) ) 
    215216            WRITE(numout,*) ' frld   3 : ', SUM( frld   (:,:) ), ' sist     : ', SUM( sist   (:,:) ) 
    … …  
    220221         CALL lim_thd                                                ! Ice thermodynamics ! 
    221222         !                                                           !--------------------! 
    222          IF( l_ctl .AND. lwp ) THEN 
     223         IF( l_ctl ) THEN 
    223224            WRITE(numout,*) ' hsnif  4 : ', SUM( hsnif  (:,:) ), ' hicnif   : ', SUM( hicif  (:,:) ) 
    224225            WRITE(numout,*) ' frld   4 : ', SUM( frld   (:,:) ), ' sist     : ', SUM( sist   (:,:) ) 
    … …  
    270271#else 
    271272   !!---------------------------------------------------------------------- 
    272    !!   Default option                                 NO LIM sea-ice model 
    273    !!---------------------------------------------------------------------- 
    274    USE in_out_manager 
    275  
     273   !!   Default option           Dummy module          NO LIM sea-ice model 
     274   !!---------------------------------------------------------------------- 
    276275CONTAINS 
    277  
    278    SUBROUTINE ice_stp ( kt )            ! Empty routine 
    279       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    280  
    281       IF( kt == nit000 ) THEN 
    282          IF(lwp) WRITE(numout,*) 
    283          IF(lwp) WRITE(numout,*) 'No Sea Ice Model' 
    284          IF(lwp) WRITE(numout,*) '~~~~~~~' 
    285       ENDIF 
    286  
     276   SUBROUTINE ice_stp ( kt )     ! Dummy routine 
     277      WRITE(*,*) 'ice_stp: You should not have seen this print! error?', kt 
    287278   END SUBROUTINE ice_stp 
    288  
    289279#endif 
    290280 

  • trunk/NEMO/LIM_SRC/limadv.F90

    r3 r88  
    11MODULE limadv  
    2 #if defined key_ice_lim 
    32   !!====================================================================== 
    43   !!                       ***  MODULE limadv   *** 
    54   !! LIM sea-ice model : sea-ice advection 
    65   !!====================================================================== 
    7  
     6#if defined key_ice_lim 
     7   !!---------------------------------------------------------------------- 
     8   !!   'key_ice_lim'                                     LIM sea-ice model 
    89   !!---------------------------------------------------------------------- 
    910   !!   lim_adv_x  : advection of sea ice on x axis 
    … …  
    221222      CALL lbc_lnk( psxy, 'T', 1. ) 
    222223 
    223       IF( l_ctl .AND. lwp ) THEN 
     224      IF(l_ctl) THEN 
    224225         WRITE(numout,*) ' lim_adv_x: psm  ', SUM( psm  ), ' ps0  ', SUM( ps0  ) 
    225226         WRITE(numout,*) ' lim_adv_x: psx  ', SUM( psx  ), ' psxx ', SUM( psxx ) 
    … …  
    421422      CALL lbc_lnk( psxy, 'T', 1. ) 
    422423 
    423       IF( l_ctl .AND. lwp ) THEN 
     424      IF(l_ctl) THEN 
    424425         WRITE(numout,*) ' lim_adv_y: psm  ', SUM( psm  ), ' ps0  ', SUM( ps0  ) 
    425426         WRITE(numout,*) ' lim_adv_y: psx  ', SUM( psx  ), ' psxx ', SUM( psxx ) 
    … …  
    430431   END SUBROUTINE lim_adv_y 
    431432 
    432    !!====================================================================== 
    433433#else 
    434    !!============================================================================== 
    435    !!                       ***  MODULE limadv   *** 
    436    !!                              No sea ice 
    437    !!============================================================================== 
     434   !!---------------------------------------------------------------------- 
     435   !!   Default option            Dummy module         NO LIM sea-ice model 
     436   !!---------------------------------------------------------------------- 
    438437CONTAINS 
    439438   SUBROUTINE lim_adv_x         ! Empty routine 

  • trunk/NEMO/LIM_SRC/limflx.F90

    r33 r88  
    99   !!---------------------------------------------------------------------- 
    1010   !!   lim_flx  : flux at the ice / ocean interface 
     11   !!---------------------------------------------------------------------- 
    1112   !! * Modules used 
    1213   USE par_oce 
    … …  
    2627   PUBLIC lim_flx       ! called by lim_step 
    2728 
    28   !! * Module variables 
    29      REAL(wp)  ::            &  ! constant values 
    30          epsi16 = 1e-16   ,  & 
    31          rzero  = 0.0    ,  & 
    32          rone   = 1.0 
     29   !! * Module variables 
     30   REAL(wp)  ::            &  ! constant values 
     31      epsi16 = 1.e-16  ,  & 
     32      rzero  = 0.e0    ,  & 
     33      rone   = 1.e0 
     34 
    3335   !! * Substitutions 
    3436#  include "vectopt_loop_substitute.h90" 
    … …  
    4143      !!------------------------------------------------------------------- 
    4244      !!                ***  ROUTINE lim_flx *** 
    43       !!                 
    4445      !!   
    4546      !! ** Purpose : Computes the mass and heat fluxes to the ocean 
    … …  
    5354      !!              - fmass   : freshwater flux at sea ice/ocean interface 
    5455      !! 
    55       !! 
    5656      !! ** References : 
    5757      !!       H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 
    … …  
    5959      !!         addition    : 02-07 (C. Ethe, G. Madec) 
    6060      !!--------------------------------------------------------------------- 
    61       !! * Modules used 
    6261      !! * Local variables 
    6362      INTEGER ::   ji, jj         ! dummy loop indices 
    … …  
    174173      !-----------------------------------------------! 
    175174 
    176       DO jj = 1, jpj 
    177          DO ji = 1, jpi 
    178             ftaux (ji,jj) = - tio_u(ji,jj) * rau0   ! taux ( ice: N/m2/rau0, ocean: N/m2 ) 
    179             ftauy (ji,jj) = - tio_v(ji,jj) * rau0   ! tauy ( ice: N/m2/rau0, ocean: N/m2 )                 
    180             freeze(ji,jj) = 1.0 - frld(ji,jj)       ! Sea ice cover             
    181             tn_ice(ji,jj) = sist(ji,jj)             ! Ice surface temperature                       
    182          END DO 
    183       END DO 
     175      ftaux (:,:) = - tio_u(:,:) * rau0   ! taux ( ice: N/m2/rau0, ocean: N/m2 ) 
     176      ftauy (:,:) = - tio_v(:,:) * rau0   ! tauy ( ice: N/m2/rau0, ocean: N/m2 )                 
     177      freeze(:,:) = 1.0 - frld(:,:)       ! Sea ice cover             
     178      tn_ice(:,:) = sist(:,:)             ! Ice surface temperature                       
    184179 
    185180#if defined key_coupled             
    … …  
    194189      CALL flx_blk_albedo( zalb, zalcn, zalbp, zaldum ) 
    195190 
    196       DO jj = 1, jpj 
    197          DO ji = 1, jpi 
    198             alb_ice(ji,jj) =  0.5 * zalbp(ji,jj) + 0.5 * zalb (ji,jj)  ! Ice albedo                        
    199          END DO 
    200       END DO 
    201 #endif 
    202  
    203       IF( l_ctl .AND. lwp ) THEN 
     191      alb_ice(:,:) =  0.5 * zalbp(:,:) + 0.5 * zalb (:,:)   ! Ice albedo                        
     192#endif 
     193 
     194      IF(l_ctl) THEN 
    204195         WRITE(numout,*) ' lim_flx  ' 
    205196         WRITE(numout,*) ' fsolar ', SUM(fsolar), ' fnsolar', SUM( fnsolar ) 
    … …  
    208199         WRITE(numout,*) ' freeze ', SUM(freeze), ' tn_ice ', SUM(tn_ice) 
    209200      ENDIF  
    210   
    211201    
    212202    END SUBROUTINE lim_flx 
    … …  
    214204#else 
    215205   !!---------------------------------------------------------------------- 
    216    !!   Default option :        Empty module           NO LIM sea-ice model 
     206   !!   Default option :        Dummy module           NO LIM sea-ice model 
    217207   !!---------------------------------------------------------------------- 
    218208CONTAINS 
    219    SUBROUTINE lim_flx         ! Empty routine 
     209   SUBROUTINE lim_flx         ! Dummy routine 
    220210   END SUBROUTINE lim_flx 
    221211#endif  
    222212 
     213   !!====================================================================== 
    223214END MODULE limflx 

  • trunk/NEMO/LIM_SRC/limhdf.F90

    r12 r88  
    11MODULE limhdf 
    2 #if defined key_ice_lim 
    32   !!====================================================================== 
    43   !!                    ***  MODULE limhdf   *** 
    5    !! LIM diffusion ice model : sea-ice variables horizontal diffusion 
     4   !! LIM ice model : horizontal diffusion of sea-ice quantities 
    65   !!====================================================================== 
    7  
     6#if defined key_ice_lim 
     7   !!---------------------------------------------------------------------- 
     8   !!   'key_ice_lim'                                     LIM sea-ice model 
    89   !!---------------------------------------------------------------------- 
    910   !!   lim_hdf  : diffusion trend on sea-ice variable 
    … …  
    9697            DO ji = fs_2 , fs_jpim1   ! vector opt. 
    9798               zfact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj  ) + e1v(ji,jj) + e1v(ji,jj-1) ) & 
    98                              / ( e1t(ji,jj) * e2t(ji,jj) ) 
     99                  &          / ( e1t(ji,jj) * e2t(ji,jj) ) 
    99100            END DO 
    100101         END DO 
    … …  
    144145 
    145146         ! convergence test 
    146          zconv = 0.0 
     147         zconv = 0.e0 
    147148         DO jj = 2, jpjm1 
    148149            DO ji = 2, jpim1 
    … …  
    165166 
    166167      ptab(:,:) = ptab(:,:) 
    167       IF( l_ctl .AND. lwp ) THEN 
    168          WRITE(numout,*) ' lim_hdf  : ', SUM( ptab-ptab0 ), ' zconv= ', zconv, ' iter= ', iter 
    169       ENDIF 
     168 
     169      IF(l_ctl)   WRITE(numout,*) ' lim_hdf  : ', SUM( ptab-ptab0 ), ' zconv= ', zconv, ' iter= ', iter 
    170170 
    171171   END SUBROUTINE lim_hdf 
     172 
    172173#else 
    173    !!====================================================================== 
    174    !!                       ***  MODULE limhdf   *** 
    175    !!                          no sea ice model 
    176    !!====================================================================== 
     174   !!---------------------------------------------------------------------- 
     175   !!   Default option          Dummy module           NO LIM sea-ice model 
     176   !!---------------------------------------------------------------------- 
    177177CONTAINS 
    178178   SUBROUTINE lim_hdf         ! Empty routine 

  • trunk/NEMO/LIM_SRC/limrst.F90

    r3 r88  
    8484      zinfo(2) = FLOAT( it0   )   ! iteration number 
    8585 
    86       zsec     = 0. 
     86      zsec     = 0.e0 
    8787      itime    = 0 
    88       zdept(1) = 0. 
     88      zdept(1) = 0.e0 
    8989      zdt      = rdt_ice * nstock 
    9090 

  • trunk/NEMO/LIM_SRC/limthd_lac.F90

    r12 r88  
    2222   PUBLIC lim_thd_lac     ! called by lim_thd 
    2323 
    24   !! * Module variables 
    25      REAL(wp)  ::            &  ! constant values 
    26          epsi20 = 1e-20   ,  & 
    27          epsi13 = 1e-13   ,  & 
    28          zzero  = 0.0     ,  & 
    29          zone   = 1.0 
     24   !! * Module variables 
     25   REAL(wp)  ::            &  ! constant values 
     26      epsi20 = 1.e-20  ,  & 
     27      epsi13 = 1.e-13  ,  & 
     28      zzero  = 0.e0    ,  & 
     29      zone   = 1.e0 
    3030   !!---------------------------------------------------------------------- 
    3131   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003) 
    … …  
    3333CONTAINS 
    3434     
    35     SUBROUTINE lim_thd_lac( kideb, kiut ) 
     35   SUBROUTINE lim_thd_lac( kideb, kiut ) 
    3636      !!------------------------------------------------------------------- 
    3737      !!               ***   ROUTINE lim_thd_lac  *** 
    … …  
    6363      !!      Fichefet T. and M. Maqueda 1997, J. Geo. Res., 102(C6),  
    6464      !!                                                12609 -12646    
    65       !! 
    6665      !! History : 
    6766      !!   1.0  !  01-04 (LIM)  original code 

  • trunk/NEMO/LIM_SRC/limthd_zdf.F90

    r12 r88  
    11MODULE limthd_zdf 
    2 #if defined key_ice_lim 
    32   !!====================================================================== 
    43   !!                       ***  MODULE limthd_zdf *** 
    54   !!                thermodynamic growth and decay of the ice  
    65   !!====================================================================== 
    7  
     6#if defined key_ice_lim 
     7   !!---------------------------------------------------------------------- 
     8   !!   'key_ice_lim'                                     LIM sea-ice model 
    89   !!---------------------------------------------------------------------- 
    910   !!   lim_thd_zdf  : vertical accr./abl. and lateral ablation of sea ice 
     11   !!---------------------------------------------------------------------- 
    1012   !! * Modules used 
    1113   USE par_oce          ! ocean parameters 
    … …  
    2527   !! * Module variables 
    2628   REAL(wp)  ::           &  ! constant values 
    27       epsi20 = 1e-20   ,  & 
    28       epsi13 = 1e-13   ,  & 
    29       zzero  = 0.0     ,  & 
    30       zone   = 1.0 
     29      epsi20 = 1.e-20  ,  & 
     30      epsi13 = 1.e-13  ,  & 
     31      zzero  = 0.e0    ,  & 
     32      zone   = 1.e0 
    3133   !!---------------------------------------------------------------------- 
    3234   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003) 
    … …  
    3537 
    3638   SUBROUTINE lim_thd_zdf( kideb , kiut ) 
    37        !!------------------------------------------------------------------ 
    38        !!                ***  ROUTINE lim_thd_zdf  *** 
    39        !!               
    40        !! ** Purpose : This routine determines the time evolution of snow  
    41        !!      and sea-ice thicknesses, concentration and heat content  
    42        !!      due to the vertical and lateral thermodynamic accretion- 
    43        !!      ablation processes. One only treats the case of lat. abl. 
    44        !!      For lateral accretion, see routine lim_lat_accr  
    45        !!  
    46        !! ** Method  : The representation of vertical growth and decay of  
    47        !!      the sea-ice model is based upon the diffusion of heat  
    48        !!      through the external and internal boundaries of a  
    49        !!      three-layer system (two layers of ice and one layer and  
    50        !!      one layer of snow, if present, on top of the ice). 
    51        !!  
    52        !! ** Action  : - Calculation of some intermediates variables 
    53        !!              - Calculation of surface temperature 
    54        !!              - Calculation of available heat for surface ablation 
    55        !!              - Calculation of the changes in internal temperature  
    56        !!                of the three-layer system, due to vertical diffusion  
    57        !!                processes 
    58        !!              - Performs surface ablation and bottom accretion-ablation 
    59        !!              - Performs snow-ice formation 
    60        !!              - Performs lateral ablation 
    61        !! 
    62        !! References : 
    63        !!   Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646    
    64        !!   Fichefet T. and M. Maqueda 1999, Clim. Dyn, 15(4), 251-268   
    65        !! 
    66        !! History : 
    67        !!   original    : 01-04 (LIM) 
    68        !!   addition    : 02-08 (C. Ethe, G. Madec) 
    69        !!------------------------------------------------------------------ 
    70        !! * Arguments 
    71        INTEGER , INTENT (in) ::  & 
    72           kideb ,  &  ! Start point on which the  the computation is applied 
    73           kiut        ! End point on which the  the computation is applied 
    74  
    75        !! * Local variables 
    76        INTEGER ::   ji       ! dummy loop indices 
    77  
    78        REAL(wp) , DIMENSION(jpij,2) ::  & 
    79           zqcmlt        ! energy due to surface( /1 ) and bottom melting( /2 ) 
    80  
    81        REAL(wp), DIMENSION(jpij) ::  & 
    82           ztsmlt      &    ! snow/ice surface melting temperature 
    83           ,ztbif      &    ! int. temp. at the mid-point of the 1st layer of the snow/ice sys.  
    84           ,zksn       &    ! effective conductivity of snow 
    85           ,zkic       &    ! effective conductivity of ice 
    86           ,zksndh     &    ! thermal cond. at the mid-point of the 1st layer of the snow/ice sys.  
    87           , zfcsu     &    ! conductive heat flux at the surface of the snow/ice system  
    88           , zfcsudt   &    ! = zfcsu * dt 
    89           , zi0       &    ! frac. of the net SW rad. which is not absorbed at the surface 
    90           , z1mi0     &    ! fraction of the net SW radiation absorbed at the surface 
    91           , zqmax     &    ! maximum energy stored in brine pockets 
    92           , zrcpdt    &    ! h_su*rho_su*cp_su/dt(h_su being the thick. of surf. layer) 
    93           , zts_old   &    ! previous surface temperature 
    94           , zidsn , z1midsn , zidsnic ! tempory variables 
    95  
    96        REAL(wp), DIMENSION(jpij) :: & 
     39      !!------------------------------------------------------------------ 
     40      !!                ***  ROUTINE lim_thd_zdf  *** 
     41      !!               
     42      !! ** Purpose : This routine determines the time evolution of snow  
     43      !!      and sea-ice thicknesses, concentration and heat content  
     44      !!      due to the vertical and lateral thermodynamic accretion- 
     45      !!      ablation processes. One only treats the case of lat. abl. 
     46      !!      For lateral accretion, see routine lim_lat_accr  
     47      !!  
     48      !! ** Method  : The representation of vertical growth and decay of  
     49      !!      the sea-ice model is based upon the diffusion of heat  
     50      !!      through the external and internal boundaries of a  
     51      !!      three-layer system (two layers of ice and one layer and  
     52      !!      one layer of snow, if present, on top of the ice). 
     53      !!  
     54      !! ** Action  : - Calculation of some intermediates variables 
     55      !!              - Calculation of surface temperature 
     56      !!              - Calculation of available heat for surface ablation 
     57      !!              - Calculation of the changes in internal temperature  
     58      !!                of the three-layer system, due to vertical diffusion  
     59      !!                processes 
     60      !!              - Performs surface ablation and bottom accretion-ablation 
     61      !!              - Performs snow-ice formation 
     62      !!              - Performs lateral ablation 
     63      !! 
     64      !! References : 
     65      !!   Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646    
     66      !!   Fichefet T. and M. Maqueda 1999, Clim. Dyn, 15(4), 251-268   
     67      !! 
     68      !! History : 
     69      !!   original    : 01-04 (LIM) 
     70      !!   addition    : 02-08 (C. Ethe, G. Madec) 
     71      !!------------------------------------------------------------------ 
     72      !! * Arguments 
     73      INTEGER , INTENT (in) ::  & 
     74         kideb ,  &  ! Start point on which the  the computation is applied 
     75         kiut        ! End point on which the  the computation is applied 
     76 
     77      !! * Local variables 
     78      INTEGER ::   ji       ! dummy loop indices 
     79 
     80      REAL(wp) , DIMENSION(jpij,2) ::  & 
     81         zqcmlt        ! energy due to surface( /1 ) and bottom melting( /2 ) 
     82 
     83      REAL(wp), DIMENSION(jpij) ::  & 
     84         ztsmlt      &    ! snow/ice surface melting temperature 
     85         ,ztbif      &    ! int. temp. at the mid-point of the 1st layer of the snow/ice sys.  
     86         ,zksn       &    ! effective conductivity of snow 
     87         ,zkic       &    ! effective conductivity of ice 
     88         ,zksndh     &    ! thermal cond. at the mid-point of the 1st layer of the snow/ice sys.  
     89         , zfcsu     &    ! conductive heat flux at the surface of the snow/ice system  
     90         , zfcsudt   &    ! = zfcsu * dt 
     91         , zi0       &    ! frac. of the net SW rad. which is not absorbed at the surface 
     92         , z1mi0     &    ! fraction of the net SW radiation absorbed at the surface 
     93         , zqmax     &    ! maximum energy stored in brine pockets 
     94         , zrcpdt    &    ! h_su*rho_su*cp_su/dt(h_su being the thick. of surf. layer) 
     95         , zts_old   &    ! previous surface temperature 
     96         , zidsn , z1midsn , zidsnic ! tempory variables 
     97 
     98      REAL(wp), DIMENSION(jpij) :: & 
    9799          zfnet       &  ! net heat flux at the top surface( incl. conductive heat flux) 
    98100          , zsprecip  &    ! snow accumulation 
    … …  
    420422          zplediag(3) = 1 + 3.0 * sbeta * zkhic    
    421423 
    422           zsubdiag(1) = 0.0               
    423           zsubdiag(2) = -1.0 * z1midsn(ji) * sbeta * zkhicint 
    424           zsubdiag(3) = -1.0 * sbeta * zkhic  
    425  
    426           zsupdiag(1) =  -1.0 * z1midsn(ji) * sbeta * zkhsnint  
     424          zsubdiag(1) =  0.e0               
     425          zsubdiag(2) = -1.e0 * z1midsn(ji) * sbeta * zkhicint 
     426          zsubdiag(3) = -1.e0 * sbeta * zkhic  
     427 
     428          zsupdiag(1) = -1.e0 * z1midsn(ji) * sbeta * zkhsnint  
    427429          zsupdiag(2) = zsubdiag(3) 
    428           zsupdiag(3) = 0.0 
     430          zsupdiag(3) =  0.e0 
    429431           
    430432          !     6.3. Fulfill the idependent term vector. 

  • trunk/NEMO/LIM_SRC/limwri.F90

    r3 r88  
    3232 
    3333   !! * Module variables 
     34   INTEGER, PARAMETER ::   &  !: 
     35      jpnoumax = 40             !: maximum number of variable for ice output 
    3436   INTEGER  ::                                & 
    3537      noumef                                     ! number of fields 
    36    REAL(wp)           , DIMENSION(noumax) ::  & 
     38   REAL(wp)           , DIMENSION(jpnoumax) ::  & 
    3739      cmulti ,                                &  ! multiplicative constant 
    3840      cadd                                       ! additive constant 
    39    CHARACTER(len = 35), DIMENSION(noumax) ::  & 
     41   CHARACTER(len = 35), DIMENSION(jpnoumax) ::  & 
    4042      titn                                       ! title of the field 
    41    CHARACTER(len = 8 ), DIMENSION(noumax) ::  & 
     43   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::  & 
    4244      nam                                        ! name of the field 
    43    CHARACTER(len = 8 ), DIMENSION(noumax) ::  & 
     45   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::  & 
    4446      uni                                        ! unit of the field 
    45    INTEGER            , DIMENSION(noumax) ::  & 
     47   INTEGER            , DIMENSION(jpnoumax) ::  & 
    4648      nc                                         ! switch for saving field ( = 1 ) or not ( = 0 ) 
    4749 
    4850   REAL(wp)  ::            &  ! constant values 
    49       epsi16 = 1e-16   ,  & 
    50       zzero  = 0.0     ,  & 
    51       zone   = 1.0 
     51      epsi16 = 1.e-16   ,  & 
     52      zzero  = 0.e0     ,  & 
     53      zone   = 1.e0 
     54   !!------------------------------------------------------------------- 
    5255 
    5356CONTAINS 
    … …  
    7073         zindh,zinda,zindb,  & 
    7174         ztmu 
    72       REAL(wp), DIMENSION(jpi,jpj,noumax) :: & 
     75      REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: & 
    7376         zcmo 
    7477      REAL(wp), DIMENSION(jpi,jpj) ::  & 
    … …  
    8487         ndex51   
    8588      !!------------------------------------------------------------------- 
    86   
    87  
    8889       
    8990      IF ( numit == nstart ) THEN  
    … …  
    111112         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 
    112113          
    113          DO jf = 1 , noumef 
     114         DO jf = 1, noumef 
    114115            IF ( nc(jf) == 1 ) THEN 
    115                CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj & 
     116               CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj   & 
    116117                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    117118            ENDIF 
    … …  
    133134      !-- calculs des valeurs instantanees 
    134135       
    135       zcmo( 1:jpi, 1:jpj, 1:noumax ) = 0.0  
     136      zcmo(:,:, 1:jpnoumax ) = 0.e0  
    136137      DO jj = 2 , jpjm1 
    137138         DO ji = 2 , jpim1 
    … …  
    229230         field_19 
    230231 
    231       TYPE(FIELD) , DIMENSION(noumax) :: zfield 
     232      TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield 
    232233 
    233234      NAMELIST/namiceout/ noumef, & 

  • trunk/NEMO/LIM_SRC/par_ice.F90

    r12 r88  
    77   USE par_oce 
    88 
    9    INTEGER, PARAMETER ::   &  !: 
    10       kmax =   1    ,      &  !: ??? 
    11       nsmax =  2              !: ??? 
     9   IMPLICIT NONE 
     10   PUBLIC               ! allows par_oce and par_kind to be known in ice modules 
    1211 
    13    !!-- Parameter providing the number of vertical ice layers 
    14     
    15    INTEGER , PARAMETER ::      &  !: 
    16       nlayers   = 2 ,          &  !: ??? 
    17       nlayersp1 = nlayers + 1     !: ??? 
     12   INTEGER, PUBLIC, PARAMETER ::   &  !: 
     13      jpkmax =  1    ,      &  !: ??? 
     14      jpsmax =  2              !: ??? 
    1815 
    19    ! maximum number of variable for output 
    20    INTEGER, PARAMETER ::   &  !: 
    21       noumax = 40             !: ??? 
    22  
    23    ! Parameters for outputs to files "evolu" made by routine "informe" : ??? 
    24    INTEGER, PARAMETER ::       &  !: 
    25       ninfmx = 100        ,    &  !: maximum number of key variables 
    26       nchinf = 5          ,    &  !: ??? 
    27       nchsep = nchinf + 2         !: ??? 
     16   INTEGER, PUBLIC, PARAMETER ::   &  !:  
     17      jplayers   = 2 ,           &  !: number of vertical ice layers 
     18      jplayersp1 = jplayers + 1     !: ??? 
    2819 
    2920   !!====================================================================== 

  • trunk/NEMO/LIM_SRC/thd_ice.F90

    r12 r88  
    7676      dqla_ice_1d          !:    "                  "      dqla_ice 
    7777 
    78    REAL(wp), PUBLIC, DIMENSION(jpij,nlayersp1) ::   &  !: 
     78   REAL(wp), PUBLIC, DIMENSION(jpij,jplayersp1) ::   &  !: 
    7979      tbif_1d              !: corresponding to the 2D var  tbif 
    8080 

  • trunk/NEMO/OPA_SRC/cpl_oce.F90

    r14 r88  
    234234      cpl_f_readflx,   &  !: coupler to ocean file name for flx.coupled 
    235235      cpl_f_readtau,   &  !: coupler to ocean file name for tau.coupled 
    236       cpl_f_writ   ,   &  !: ocean to coupler file name for stp_cmo 
     236      cpl_f_writ   ,   &  !: ocean to coupler file name for cpl_stp 
    237237      cpl_readflx  ,   &  !: coupler to ocean field name for flx.coupled 
    238238      cpl_readtau  ,   &  !: coupler to ocean field name for tau.coupled 
    239       cpl_writ            !: ocean to coupler field name for stp_cmo 
     239      cpl_writ            !: ocean to coupler field name for cpl_stp 
    240240 
    241241  REAL(wp), DIMENSION(jpi,jpj) ::   &  !: 

  • trunk/NEMO/OPA_SRC/geo2ocean.F90

    r3 r88  
    233233         pte, ptn, ptv 
    234234      REAL(wp), PARAMETER :: rpi = 3.141592653E0 
    235       REAL(wp), PARAMETER :: rad = rpi / 180.0E0 
     235      REAL(wp), PARAMETER :: rad = rpi / 180.e0 
    236236 
    237237      !! * Local variables 

  • trunk/NEMO/OPA_SRC/in_out_manager.F90

    r15 r88  
    6464      numwri     = 40 ,      &  !: logical unit for output write 
    6565      numisp     = 41 ,      &  !: logical unit for island statistics 
     66      numgap     = 45 ,      &  !: logical unit for differences diagnostic 
    6667      numwrs     = 46 ,      &  !: logical unit for output restart 
    6768      numtdt     = 62 ,      &  !: logical unit for data temperature 
    6869      numsdt     = 63 ,      &  !: logical unit for data salinity 
     70      numrnf     = 64 ,      &  !: logical unit for runoff data 
    6971      numwso     = 71 ,      &  !: logical unit for 2d output write 
    7072      numwvo     = 72 ,      &  !: logical unit for 3d output write 
    7173      numsst     = 65 ,      &  !: logical unit for surface temperature data 
    72       numgap     = 45 ,      &  !: logical unit for differences diagnostic 
    7374      numbol     = 67 ,      &  !: logical unit for "bol" diagnostics 
    7475      numptr     = 68 ,      &  !: logical unit for Poleward TRansports 

  • trunk/NEMO/OPA_SRC/lbclnk.F90

    r15 r88  
    7272         !             !   =-1 , the sign is changed if north fold boundary 
    7373         !             !   = 1 , no sign change 
     74         !             !   = 0 , no sign change and > 0 required (use the inner 
     75         !             !         row/column if closed boundary) 
    7476 
    7577      !! * Local declarations 
    … …  
    8991 
    9092         CASE ( 1 , 4 , 6 )                    ! * cyclic east-west 
    91  
    9293            pt3d( 1 ,:,jk) = pt3d(jpim1,:,jk)          ! all points 
    9394            pt3d(jpi,:,jk) = pt3d(  2  ,:,jk) 
    9495 
    9596         CASE DEFAULT                          ! * closed 
    96  
    9797            SELECT CASE ( cd_type ) 
    98  
    9998            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    10099               pt3d( 1 ,:,jk) = 0.e0 
    101100               pt3d(jpi,:,jk) = 0.e0 
    102  
    103101            CASE ( 'F' )                               ! F-point 
    104102               pt3d(jpi,:,jk) = 0.e0 
    105  
    106103            END SELECT 
    107104 
    … …  
    115112 
    116113            SELECT CASE ( cd_type ) 
    117  
    118114            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points 
    119115               pt3d(:, 1 ,jk) = pt3d(:,3,jk) 
    120116               pt3d(:,jpj,jk) = 0.e0 
    121  
    122117            CASE ( 'V' , 'F' )                         ! V-, F-points 
    123118               pt3d(:, 1 ,jk) = psgn * pt3d(:,2,jk) 
    124119               pt3d(:,jpj,jk) = 0.e0 
    125  
    126120            END SELECT 
    127121 
    128          CASE ( 3 , 4 )                            ! *  North fold  T-point pivot 
     122         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot 
    129123 
    130124            pt3d( 1 ,jpj,jk) = 0.e0 
    … …  
    132126 
    133127            SELECT CASE ( cd_type ) 
    134  
    135128            CASE ( 'T' , 'W' )                         ! T-, W-point 
    136129               DO ji = 2, jpi 
    … …  
    143136                  pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk) 
    144137               END DO 
    145  
    146138            CASE ( 'U' )                               ! U-point 
    147139               DO ji = 1, jpi-1 
    … …  
    154146                  pt3d(ji,jpjm1,jk) = psgn * pt3d(iju,jpjm1,jk) 
    155147               END DO 
    156  
    157148            CASE ( 'V' )                               ! V-point 
    158149                  DO ji = 2, jpi 
    … …  
    162153                     pt3d(ji,jpj  ,jk) = psgn * pt3d(ijt,jpj-3,jk) 
    163154                  END DO 
    164  
    165155            CASE ( 'F' )                               ! F-point 
    166156                  DO ji = 1, jpi-1 
    … …  
    169159                     pt3d(ji,jpj  ,jk) = pt3d(iju,jpj-3,jk) 
    170160                  END DO 
    171  
    172161            END SELECT 
    173162 
    … …  
    178167 
    179168            SELECT CASE ( cd_type ) 
    180  
    181169            CASE ( 'T' , 'W' )                         ! T-, W-point 
    182170               DO ji = 1, jpi 
    … …  
    185173                  pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-1,jk) 
    186174               END DO 
    187  
    188175            CASE ( 'U' )                               ! U-point 
    189176                  DO ji = 1, jpi-1 
    … …  
    192179                     pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-1,jk) 
    193180                  END DO 
    194  
    195181            CASE ( 'V' )                               ! V-point 
    196182                  DO ji = 1, jpi 
    … …  
    203189                     pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk) 
    204190                  END DO 
    205  
    206191            CASE ( 'F' )                               ! F-point 
    207192                  DO ji = 1, jpi-1 
    … …  
    215200            END SELECT 
    216201 
    217          CASE DEFAULT                           ! *  closed 
     202         CASE DEFAULT                          ! *  closed 
    218203 
    219204            SELECT CASE ( cd_type ) 
    220  
    221205            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    222206               pt3d(:, 1 ,jk) = 0.e0 
    223207               pt3d(:,jpj,jk) = 0.e0 
    224  
    225208            CASE ( 'F' )                               ! F-point 
    226209               pt3d(:,jpj,jk) = 0.e0 
    227  
    228210            END SELECT 
    229211 
    … …  
    273255 
    274256      CASE ( 1 , 4 , 6 )                       ! * cyclic east-west 
    275  
    276257         pt2d( 1 ,:) = pt2d(jpim1,:) 
    277258         pt2d(jpi,:) = pt2d(  2  ,:) 
    278259 
    279260      CASE DEFAULT                             ! * closed  
    280  
    281261         SELECT CASE ( cd_type ) 
    282  
    283262         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points 
    284263            pt2d( 1 ,:) = 0.e0 
    285264            pt2d(jpi,:) = 0.e0 
    286  
    287          CASE ( 'F' , 'I' )                            ! F-point, ice U-V point 
     265         CASE ( 'F' )                                  ! F-point, ice U-V point 
    288266            pt2d(jpi,:) = 0.e0  
    289  
     267         CASE ( 'I' )                                  ! F-point, ice U-V point 
     268            pt2d( 1 ,:) = 0.e0  
     269            pt2d(jpi,:) = 0.e0  
    290270         END SELECT 
    291271 
    … …  
    299279 
    300280         SELECT CASE ( cd_type ) 
    301  
    302281         CASE ( 'T' , 'U' , 'W' )                      ! T-, U-, W-points 
    303282            pt2d(:, 1 ) = pt2d(:,3) 
    304283            pt2d(:,jpj) = 0.e0 
    305  
    306          CASE ( 'V' , 'F' )                            ! V-, F-points, ice U-V point 
     284         CASE ( 'V' , 'F' , 'I' )                      ! V-, F-points, ice U-V point 
    307285            pt2d(:, 1 ) = psgn * pt2d(:,2) 
    308286            pt2d(:,jpj) = 0.e0 
    309  
    310287         END SELECT 
    311288 
    … …  
    419396 
    420397         SELECT CASE ( cd_type ) 
    421  
    422398         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points 
    423399            pt2d(:, 1 ) = 0.e0 
    424400            pt2d(:,jpj) = 0.e0 
    425  
    426401         CASE ( 'F' )                                  ! F-point 
    427402            pt2d(:,jpj) = 0.e0 
    428  
    429403         CASE ( 'I' )                                  ! ice U-V point 
    430404            pt2d(:, 1 ) = 0.e0 
    431405            pt2d(:,jpj) = 0.e0 
    432  
    433406         END SELECT 
    434407 

  • trunk/NEMO/OPA_SRC/lib_cray.f90

    r3 r88  
    99!  isrchne 
    1010!--------------------------------------------------------- 
    11         FUNCTION sdot( I, X, J, Y, K ) 
     11     FUNCTION sdot( I, X, J, Y, K ) 
    1212        DIMENSION X(1), Y(1) 
    1313        SDOT = 0. 
    … …  
    1515        SDOT = SDOT + X(1+(N-1)*J) * Y(1+(N-1)*K) 
    1616        END DO 
    17         END FUNCTION sdot 
     17     END FUNCTION sdot 
    1818!--------------------------------------------------------- 
    19         SUBROUTINE wheneq ( i, x, j, t, ind, nn ) 
     19     SUBROUTINE wheneq ( i, x, j, t, ind, nn ) 
    2020        IMPLICIT NONE 
    2121 
    … …  
    3535        END DO  
    3636 
    37         END SUBROUTINE wheneq 
     37     END SUBROUTINE wheneq 
    3838!--------------------------------------------------------- 
    39         SUBROUTINE SAXPY(I,A,X,J,Y,K) 
     39     SUBROUTINE saxpy( I, A, X, J, Y, K ) 
    4040        DIMENSION X(1),Y(1) 
    41         DO 1 N=1,I 
    42         Y(1+(N-1)*K)=A*X(1+(N-1)*J)+Y(1+(N-1)*K) 
    43   1     CONTINUE 
    44         RETURN 
    45         END 
     41        DO N = 1, I 
     42           Y(1+(N-1)*K)=A*X(1+(N-1)*J)+Y(1+(N-1)*K) 
     43        END DO 
     44     END SUBROUTINE saxpy 
    4645!--------------------------------------------------------- 
    47         FUNCTION ISRCHNE(K,X,I,B) 
     46     FUNCTION isrchne( K, X, I, B ) 
    4847        DIMENSION X(1) 
    49         DO 1 N=1,K 
    50         IF(X(1+(N-1)*I) /= B)THEN 
    51          ISRCHNE=N 
    52         RETURN 
    53         ELSE 
    54           ISRCHNE=N+1 
    55         ENDIF 
    56  1      CONTINUE 
    57         RETURN 
    58         END 
     48        DO N = 1, K 
     49           IF( X(1+(N-1)*I) /= B ) THEN 
     50              ISRCHNE = N 
     51              RETURN 
     52           ELSE 
     53              ISRCHNE = N + 1 
     54           ENDIF 
     55        END DO 
     56     END FUNCTION isrchne 

  • trunk/NEMO/OPA_SRC/lib_isml.f90

    r3 r88  
    1414! 
    1515!--------------------------------------------------------- 
    16       SUBROUTINE linrg(kn,pa,klda,painv,kldainv) 
    17  
    18 ! compute inverse matrix 
     16   SUBROUTINE linrg(kn,pa,klda,painv,kldainv) 
     17 
     18      !! compute inverse matrix 
    1919 
    2020      IMPLICIT NONE  
    … …  
    2626      INTEGER ji 
    2727 
    28       IF (kn /= klda.or.kn /= kldainv) THEN  
     28      IF( kn /= klda .OR. kn /= kldainv ) THEN  
    2929          write(0,*)'change your parameters' 
    3030          STOP  
    3131      ENDIF  
    3232 
    33       CALL vmov(kn*kn,pa,painv) 
    34  
    35       CALL gauss(kn,painv,iplin,zv) 
    36  
    37       zb(:,:) = 0.0    
    38       DO ji=1,kn 
    39         zb(ji,ji)=1. 
    40         CALL desremopt(kn,painv,iplin,zb(1,ji),zb(1,ji),zv) 
     33      CALL vmov( kn*kn, pa, painv ) 
     34 
     35      CALL gauss( kn, painv, iplin, zv ) 
     36 
     37      zb(:,:) = 0.e0    
     38      DO ji = 1, kn 
     39        zb(ji,ji) = 1.e0 
     40        CALL desremopt( kn, painv, iplin, zb(1,ji), zb(1,ji), zv ) 
    4141      END DO  
    42       CALL vmov(kn*kn,zb,painv) 
    43  
    44       END SUBROUTINE linrg 
    45 !--------------------------------------------------------- 
    46       SUBROUTINE gauss(kn,pa,kplin,pv) 
     42      CALL vmov( kn*kn, zb, painv ) 
     43 
     44   END SUBROUTINE linrg 
     45!--------------------------------------------------------- 
     46   SUBROUTINE gauss(kn,pa,kplin,pv) 
    4747 
    4848      IMPLICIT NONE  
    … …  
    108108      END DO  
    109109 
    110       END SUBROUTINE gauss 
    111 !--------------------------------------------------------- 
    112         FUNCTION isamax( I, X ) 
    113         DIMENSION X(I) 
    114         ISAMAX=0 
    115         XMIN=-1E+50 
    116         DO 1 N=1,I 
    117         IF(ABS(X(N)) > XMIN) THEN 
    118         XMIN=X(N) 
    119         ISAMAX=N 
    120         ENDIF 
    121   1     CONTINUE 
    122         RETURN 
    123         END 
    124 !--------------------------------------------------------- 
    125       SUBROUTINE vmov(kn,px,py) 
     110   END SUBROUTINE gauss 
     111!--------------------------------------------------------- 
     112   FUNCTION isamax( I, X ) 
     113      DIMENSION X(I) 
     114      ISAMAX = 0 
     115      XMIN = -1e+50 
     116      DO N = 1, I 
     117         IF(ABS(X(N)) > XMIN ) THEN 
     118            XMIN = X(N) 
     119            ISAMAX = N 
     120         ENDIF 
     121      END DO 
     122   END FUNCTION isamax 
     123!--------------------------------------------------------- 
     124   SUBROUTINE vmov(kn,px,py) 
    126125 
    127126      IMPLICIT NONE  
    … …  
    131130 
    132131      DO ji=1,kn 
    133         py(ji)=px(ji) 
     132         py(ji)=px(ji) 
    134133      END DO  
    135134 
    136       RETURN  
    137       END  
    138 !--------------------------------------------------------- 
    139       subroutine desremopt(n,a,plin,y,x,v) 
     135   END SUBROUTINE vmov 
     136!--------------------------------------------------------- 
     137   subroutine desremopt(n,a,plin,y,x,v) 
    140138      implicit none 
    141139      integer n,i,  j0 
    … …  
    176174      end do 
    177175 
    178       end SUBROUTINE desremopt 
    179 !--------------------------------------------------------- 
    180       SUBROUTINE DTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX ) 
     176   end SUBROUTINE desremopt 
     177!--------------------------------------------------------- 
     178   SUBROUTINE DTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX ) 
    181179!!    .. Scalar Arguments .. 
    182180      INTEGER            INCX, LDA, N 
    … …  
    457455      END IF 
    458456 
    459       RETURN 
    460  
    461 !!    End of DTRSV . 
    462  
    463       END 
    464 !--------------------------------------------------------- 
    465       SUBROUTINE DGER  ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA ) 
     457   END SUBROUTINE DTRSV 
     458!--------------------------------------------------------- 
     459   SUBROUTINE DGER  ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA ) 
    466460!!    .. Scalar Arguments .. 
    467461!     DOUBLE PRECISION   ALPHA 
    … …  
    620614      END IF 
    621615 
    622       RETURN 
    623  
    624 !!    End of DGER  . 
    625  
    626       END 
    627 !--------------------------------------------------------- 
    628       SUBROUTINE XERBLA ( SRNAME, INFO ) 
     616   END SUBROUTINE DGER 
     617!--------------------------------------------------------- 
     618   SUBROUTINE XERBLA ( SRNAME, INFO ) 
    629619!!    ..    Scalar Arguments .. 
    630620      INTEGER            INFO 
    … …  
    668658               ' had an illegal value' ) 
    669659 
    670 !!    End of XERBLA. 
    671  
    672       END 
     660   END SUBROUTINE XERBLA 
    673661!----------------------------------------------------------- 
    674       FUNCTION lsame( c1, c2 ) 
     662   FUNCTION lsame( c1, c2 ) 
    675663      logical lsame 
    676664      CHARACTER (len=*), INTENT(in) ::   c1, c2 
    … …  
    680668          lsame=.FALSE. 
    681669      ENDIF 
    682  
    683       END FUNCTION lsame 
     670   END FUNCTION lsame 

  • trunk/NEMO/OPA_SRC/mppini.F90

    r15 r88  
    99   !!   mpp_init2      : Lay out the global domain over processors  
    1010   !!                    with land processor elimination 
     11   !!   mpp_init_ioispl: IOIPSL initialization in mpp 
    1112   !!---------------------------------------------------------------------- 
    1213   !! * Modules used 
    … …  
    6667         WRITE(numout,*) '~~~~~~~~~~~: ' 
    6768         WRITE(numout,*) '         nperio = ', nperio 
     69         WRITE(numout,*) '         npolj  = ', npolj 
    6870         WRITE(numout,*) '         nimpp  = ', nimpp 
    6971         WRITE(numout,*) '         njmpp  = ', njmpp 
    … …  
    140142 
    141143#if defined key_mpp_shmem 
    142       IF(lwp)WRITE(numout,*) 
    143       IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing PVM T3E + SHMEM' 
    144       IF(lwp)WRITE(numout,*) '~~~~~~~~' 
     144      IF(lwp) WRITE(numout,*) 
     145      IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing PVM T3E + SHMEM' 
     146      IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    145147 
    146148      CALL mppshmem                           ! Initialisation of shmem array 
    … …  
    148150#endif 
    149151#if defined key_mpp_mpi 
    150       IF(lwp)WRITE(numout,*) 
    151       IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI' 
    152       IF(lwp)WRITE(numout,*) '~~~~~~~~' 
     152      IF(lwp) WRITE(numout,*) 
     153      IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing MPI' 
     154      IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    153155#endif 
    154156 
    … …  
    472474      END IF 
    473475 
     476      ! Prepare NetCDF output file (if necessary) 
     477      CALL mpp_init_ioipsl 
    474478 
    475479   END SUBROUTINE mpp_init 
    476480 
    477  
    478481#  include "mppini_2.h90" 
    479482 
     483# if defined key_fdir   ||   defined key_dimgout 
     484   !!---------------------------------------------------------------------- 
     485   !!   'key_fdir' OR 'key_dimgout'                  NO use of NetCDF files 
     486   !!---------------------------------------------------------------------- 
     487   SUBROUTINE mpp_init_ioipsl       ! Dummy routine 
     488   END SUBROUTINE mpp_init_ioipsl   
     489# else 
     490   SUBROUTINE mpp_init_ioipsl 
     491      !!---------------------------------------------------------------------- 
     492      !!                  ***  ROUTINE mpp_init_ioipsl  *** 
     493      !! 
     494      !! ** Purpose :    
     495      !! 
     496      !! ** Method  :    
     497      !! 
     498      !! History : 
     499      !!   9.0  !  04-03  (G. Madec)  MPP-IOIPSL  
     500      !!---------------------------------------------------------------------- 
     501      USE ioipsl 
     502      INTEGER, DIMENSION(4) ::   & 
     503         iglo, iloc, iabsf, iabsl, ihals, ihale   ! ??? 
     504      !!---------------------------------------------------------------------- 
     505      iglo(1) = jpiglo 
     506      iglo(2) = jpjglo 
     507      iglo(3) = jpk 
     508      iglo(4) = 1 
     509      iloc(1) = nlci 
     510      iloc(2) = nlcj 
     511      iloc(3) = jpk 
     512      iloc(4) = 1 
     513      iabsf(1) = nimppt(narea) 
     514      iabsf(2) = njmppt(narea) 
     515      iabsf(3) = 1 
     516      iabsf(4) = 1 
     517      iabsl(:) = iabsf(:) + iloc(:) - 1 
     518      ihals(1) = jpreci 
     519      ihals(2) = jprecj 
     520      ihals(3) = 0 
     521      ihals(4) = 0 
     522      ihale(1) = jpreci 
     523      ihale(2) = jprecj 
     524      ihale(3) = 0 
     525      ihale(4) = 0 
     526      IF( nbondi == -1 .OR. nbondi == 2 )   ihals(1) = 0 
     527      IF( nbondi ==  1 .OR. nbondi == 2 )   ihale(1) = 0 
     528      IF( nbondj == -1 .OR. nbondj == 2 )   ihals(2) = 0 
     529      IF( nbondj ==  1 .OR. nbondj == 2 )   ihale(2) = 0 
     530      IF(lwp) THEN 
     531          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2), iloc (3), iloc (4) 
     532          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2), iabsf(3), iabsf(4) 
     533          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2), ihals(3), ihals(4) 
     534          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2), ihale(3), ihale(4) 
     535      ENDIF 
     536 
     537      CALL ioipsl_inimpp( jpnij, nproc, iglo, iloc, iabsf, iabsl, ihals, ihale ) 
     538 
     539   END SUBROUTINE mpp_init_ioipsl   
     540 
     541# endif 
    480542#endif 
     543 
    481544   !!====================================================================== 
    482545END MODULE mppini 

  • trunk/NEMO/OPA_SRC/oce.F90

    r15 r88  
    2222   !! -------------------------- 
    2323   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !: 
    24       ! before !  now      !  after  ! 
     24      ! before !  now      !  after  !      ! the after trends becomes the fields 
     25      ! fields !  fields   !  trends !      ! only in dyn(tra)_zdf and dyn(tra)_nxt 
    2526      ub       ,  un       ,  ua     ,   &  !: i-horizontal velocity (m/s) 
    2627      vb       ,  vn       ,  va     ,   &  !: j-horizontal velocity (m/s) 

  • trunk/NEMO/OPA_SRC/opa.F90

    r37 r88  
    131131      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
    132132 
    133       CALL opa_flg 
    134133                                            ! Domain decomposition 
    135134      IF( jpni*jpnj == jpnij ) THEN 
    … …  
    173172#endif 
    174173 
     174      !                                     ! Ocean scheme 
     175 
     176      CALL opa_flg                              ! Choice of algorithms 
     177 
    175178      !                                     ! Ocean physics 
    176179 
    177       CALL tra_qsr_init                         ! Salor radiation penetration 
     180      CALL tra_qsr_init                         ! Solar radiation penetration 
    178181 
    179182      CALL ldf_dyn_init                         ! Lateral ocean momentum physics 

  • trunk/NEMO/OPA_SRC/phycst.F90

    r15 r88  
    9191      !!---------------------------------------------------------------------- 
    9292      !! * Local variables 
    93       CHARACTER (len=64) ::   cform = "( 4(A13, I7) )"  
     93      CHARACTER (len=64) ::   cform = "(A9, 3(A13, I7) )"  
    9494      !!---------------------------------------------------------------------- 
    9595 
    … …  
    9797      IF(lwp) WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants' 
    9898      IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
    99       IF(lwp) WRITE(numout,*) 
    100  
    10199 
    102100      ! Ocean Parameters 
    103101      ! ---------------- 
    104102      IF(lwp) THEN 
     103         WRITE(numout,*) '       parameter file' 
    105104         WRITE(numout,*) 
    106          WRITE(numout,*) ' parameter file' 
    107          WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     105         WRITE(numout,*) '          dimension of model' 
     106         WRITE(numout,*) '              Local domain      Global domain       Data domain ' 
     107         WRITE(numout,cform) '         ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo, '   jpidta  : ', jpidta 
     108         WRITE(numout,cform) '         ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo, '   jpjdta  : ', jpjdta 
     109         WRITE(numout,cform) '         ','   jpk     : ', jpk, '   jpk     : ', jpk   , '   jpkdta  : ', jpkdta 
     110         WRITE(numout,*)      '        ','   jpij    : ', jpij 
     111         WRITE(numout,*) 
     112         WRITE(numout,*) '          mpp local domain info (mpp)' 
     113         WRITE(numout,*) '             jpni    : ', jpni, '   jpreci  : ', jpreci 
     114         WRITE(numout,*) '             jpnj    : ', jpnj, '   jprecj  : ', jprecj 
     115         WRITE(numout,*) '             jpnij   : ', jpnij 
    108116 
    109117         WRITE(numout,*) 
    110          WRITE(numout,*) ' dimension of model' 
    111          WRITE(numout,*) ' local domain                              Global domain           Data domain ' 
    112          WRITE(numout,cform) '   jpi     : ', jpi, '   jpim1   : ', jpim1, '   jpiglo  : ', jpiglo, '   jpidta  : ', jpidta 
    113          WRITE(numout,cform) '   jpj     : ', jpj, '   jpjm1   : ', jpjm1, '   jpjglo  : ', jpjglo, '   jpjdta  : ', jpjdta 
    114          WRITE(numout,cform) '   jpk     : ', jpk, '   jpkm1   : ', jpkm1, '   jpk     : ', jpk   , '   jpkdta  : ', jpkdta 
    115          WRITE(numout,*)      '  jpij    : ', jpij 
    116          WRITE(numout,*) 
    117          WRITE(numout,*) ' mpp local domain info (mpp)' 
    118          WRITE(numout,*) '   jpni    : ', jpni, '   jpreci  : ', jpreci 
    119          WRITE(numout,*) '   jpnj    : ', jpnj, '   jprecj  : ', jprecj 
    120          WRITE(numout,*) '   jpnij   : ', jpnij 
    121  
    122          WRITE(numout,*) 
    123          WRITE(numout,*) ' lateral domain boundary condition type : jperio  = ', jperio 
    124          WRITE(numout,*) ' domain island (use in rigid-lid case)  : jpisl   = ', jpisl  
    125          WRITE(numout,*) '                                          jpnisl  = ', jpnisl 
     118         WRITE(numout,*) '          lateral domain boundary condition type : jperio  = ', jperio 
     119         WRITE(numout,*) '          domain island (use in rigid-lid case)  : jpisl   = ', jpisl  
     120         WRITE(numout,*) '                                                   jpnisl  = ', jpnisl 
    126121      ENDIF 
    127  
    128122 
    129123      ! Define constants 
    130124      ! ---------------- 
    131125      IF(lwp) WRITE(numout,*) 
    132       IF(lwp) WRITE(numout,*) ' constants' 
    133       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~' 
     126      IF(lwp) WRITE(numout,*) '       constants' 
    134127 
    135128      IF(lwp) WRITE(numout,*) 
    136       IF(lwp) WRITE(numout,*) ' mathematical constant rpi = ', rpi 
     129      IF(lwp) WRITE(numout,*) '          mathematical constant                rpi = ', rpi 
    137130 
    138131      rsiyea = 365.25 * rday * 2. * rpi / 6.283076 
    … …  
    140133      omega  = 2. * rpi / rsiday  
    141134      IF(lwp) WRITE(numout,*) 
    142       IF(lwp) WRITE(numout,*) ' day          rday   = ', rday,   ' s' 
    143       IF(lwp) WRITE(numout,*) ' sideral year rsiyea = ', rsiyea, ' s' 
    144       IF(lwp) WRITE(numout,*) ' sideral day  rsiday = ', rsiday, ' s' 
    145       IF(lwp) WRITE(numout,*) ' omega        omega  = ', omega,  ' s-1' 
     135      IF(lwp) WRITE(numout,*) '          day                                rday   = ', rday,   ' s' 
     136      IF(lwp) WRITE(numout,*) '          sideral year                      rsiyea = ', rsiyea, ' s' 
     137      IF(lwp) WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s' 
     138      IF(lwp) WRITE(numout,*) '          omega                              omega  = ', omega,  ' s-1' 
    146139 
    147140      rjjss = rjjhh * rhhmm * rmmss 
    148141      IF(lwp) WRITE(numout,*) 
    149       IF(lwp) WRITE(numout,*) ' nb of months per year    raamo = ', raamo, ' months' 
    150       IF(lwp) WRITE(numout,*) ' nb of hours per day      rjjhh = ', rjjhh, ' hours' 
    151       IF(lwp) WRITE(numout,*) ' nb of minutes per hour   rhhmm = ', rhhmm, ' mn' 
    152       IF(lwp) WRITE(numout,*) ' nb of seconds per minute rmmss = ', rmmss, ' s' 
    153       IF(lwp) WRITE(numout,*) ' nb of seconds per day    rjjss = ', rjjss, ' s' 
     142      IF(lwp) WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months' 
     143      IF(lwp) WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours' 
     144      IF(lwp) WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn' 
     145      IF(lwp) WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s' 
     146      IF(lwp) WRITE(numout,*) '          nb of seconds per day               rjjss = ', rjjss, ' s' 
    154147 
    155148      IF(lwp) WRITE(numout,*) 
    156       IF(lwp) WRITE(numout,*) ' earth radius ra   = ', ra, ' m' 
    157       IF(lwp) WRITE(numout,*) ' gravity      grav = ', grav , ' m/s2' 
     149      IF(lwp) WRITE(numout,*) '          earth radius                        ra   = ', ra, ' m' 
     150      IF(lwp) WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2' 
    158151 
    159152      IF(lwp) WRITE(numout,*) 
    160       IF(lwp) WRITE(numout,*) ' triple point of temperature      rtt      = ', rtt     , ' K' 
    161       IF(lwp) WRITE(numout,*) ' freezing point of water ( C)     rt0      = ', rt0     , ' K' 
    162       IF(lwp) WRITE(numout,*) ' melting point of snow            rt0_snow = ', rt0_snow, ' K' 
    163       IF(lwp) WRITE(numout,*) ' melting point of ice             rt0_ice  = ', rt0_ice , ' K' 
     153      IF(lwp) WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K' 
     154      IF(lwp) WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K' 
     155      IF(lwp) WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K' 
     156      IF(lwp) WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K' 
    164157 
    165       ro0cpr = 1. / ( rau0 * rcp )    !  
     158      ro0cpr = 1. / ( rau0 * rcp ) 
    166159      IF(lwp) WRITE(numout,*) 
    167       IF(lwp) WRITE(numout,*) ' volumic mass of pure water (kg/m3)  rauw   = ', rauw, ' kg/m3' 
    168       IF(lwp) WRITE(numout,*) ' volumic mass of reference  (kg/m3)  rau0   = ', rau0, ' kg/m3' 
    169       IF(lwp) WRITE(numout,*) ' ocean specific heat                 rcp    = ', rcp 
    170       IF(lwp) WRITE(numout,*) '               1. / ( rau0 * rcp ) = ro0cpr = ', ro0cpr 
     160      IF(lwp) WRITE(numout,*) '          volumic mass of pure water         rauw   = ', rauw, ' kg/m^3' 
     161      IF(lwp) WRITE(numout,*) '          volumic mass of reference          rau0   = ', rau0, ' kg/m^3' 
     162      IF(lwp) WRITE(numout,*) '          ocean specific heat                rcp    = ', rcp 
     163      IF(lwp) WRITE(numout,*) '                       1. / ( rau0 * rcp ) = ro0cpr = ', ro0cpr 
    171164 
    172165      IF(lwp) THEN 
    173166         WRITE(numout,*) 
    174          WRITE(numout,*) ' thermal conductivity of the snow          = ', rcdsn   , ' J.s-1.m-1.K-1' 
    175          WRITE(numout,*) ' thermal conductivity of the ice           = ', rcdic   , ' J.s-1.m-1.K-1' 
    176          WRITE(numout,*) ' density times specific heat for snow      = ', rcpsn   , ' J.m-3.K-1'  
    177          WRITE(numout,*) ' density times specific heat for ice       = ', rcpic   , ' J.m-3.K-1'  
    178          WRITE(numout,*) ' volumetric latent heat fusion of sea ice  = ', xlic    , ' J.m-3'  
    179          WRITE(numout,*) ' volumetric latent heat fusion of snow     = ', xlsn    , ' J.m-3'  
    180          WRITE(numout,*) ' latent heat of sublimation of snow        = ', xsn     , ' J.kg-1'  
    181          WRITE(numout,*) ' density of sea ice                        = ', rhoic   , ' kg.m-3' 
    182          WRITE(numout,*) ' density of snow                           = ', rhosn   , ' kg.m-3' 
    183          WRITE(numout,*) ' emissivity of snow or ice                 = ', emic   
    184          WRITE(numout,*) ' salinity of ice                           = ', sice    , ' psu' 
    185          WRITE(numout,*) ' salinity of sea                           = ', soce    , ' psu' 
    186          WRITE(numout,*) ' latent heat of evaporation (water)        = ', cevap   , ' J.m-3'  
    187          WRITE(numout,*) ' correction factor for solar radiation     = ', srgamma  
    188          WRITE(numout,*) ' von Karman constant                       = ', vkarmn  
    189          WRITE(numout,*) ' Stefan-Boltzmann constant                 = ', stefan  , ' J.s-1.m-2.K-4' 
     167         WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K' 
     168         WRITE(numout,*) '          thermal conductivity of the ice           = ', rcdic   , ' J/s/m/K' 
     169         WRITE(numout,*) '          density times specific heat for snow      = ', rcpsn   , ' J/m^3/K'  
     170         WRITE(numout,*) '          density times specific heat for ice       = ', rcpic   , ' J/m^3/K' 
     171         WRITE(numout,*) '          volumetric latent heat fusion of sea ice  = ', xlic    , ' J/m'  
     172         WRITE(numout,*) '          volumetric latent heat fusion of snow     = ', xlsn    , ' J/m'  
     173         WRITE(numout,*) '          latent heat of sublimation of snow        = ', xsn     , ' J/kg'  
     174         WRITE(numout,*) '          density of sea ice                        = ', rhoic   , ' kg/m^3' 
     175         WRITE(numout,*) '          density of snow                           = ', rhosn   , ' kg/m^3' 
     176         WRITE(numout,*) '          emissivity of snow or ice                 = ', emic   
     177         WRITE(numout,*) '          salinity of ice                           = ', sice    , ' psu' 
     178         WRITE(numout,*) '          salinity of sea                           = ', soce    , ' psu' 
     179         WRITE(numout,*) '          latent heat of evaporation (water)        = ', cevap   , ' J/m^3'  
     180         WRITE(numout,*) '          correction factor for solar radiation     = ', srgamma  
     181         WRITE(numout,*) '          von Karman constant                       = ', vkarmn  
     182         WRITE(numout,*) '          Stefan-Boltzmann constant                 = ', stefan  , ' J/s/m^2/K^4' 
    190183 
    191184         WRITE(numout,*) 
    192          WRITE(numout,*) ' conversion: degre ==> radian rad = ', rad 
     185         WRITE(numout,*) '          conversion: degre ==> radian          rad = ', rad 
    193186 
    194187         WRITE(numout,*) 
    195          WRITE(numout,*) ' smallest real computer value= ', rsmall 
     188         WRITE(numout,*) '          smallest real computer value       rsmall = ', rsmall 
    196189      ENDIF 
    197190 
Note: See TracChangeset for help on using the changeset viewer.