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 2690 for branches/dev_r2586_dynamic_mem – NEMO

Ignore:
Timestamp:
2011-03-15T16:27:46+01:00 (13 years ago)
Author:
gm
Message:

dynamic mem: #785 ; homogeneization of the coding style associated with dyn allocation

Location:
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO
Files:
148 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90

    r2636 r2690  
    5151      ierr(:) = 0 
    5252      ! 
    53       ALLOCATE( fs2cor(jpi,jpj),  fcor(jpi,jpj),                             & 
    54          &      covrai(jpi,jpj),  area(jpi,jpj), tms(jpi,jpj), tmu(jpi,jpj), & 
    55          &      wght(jpi,jpj,2,2),  Stat=ierr(1) ) 
     53      ALLOCATE( fs2cor(jpi,jpj)     , fcor(jpi,jpj) ,                                   & 
     54         &      covrai(jpi,jpj)     , area(jpi,jpj) , tms(jpi,jpj) , tmu(jpi,jpj) ,    & 
     55         &      wght  (jpi,jpj,2,2)                                               , STAT=ierr(1) ) 
    5656         ! 
    57       ALLOCATE(                                                              & 
     57      ALLOCATE(                                                    & 
    5858#if defined key_lim2_vp  
    59          &        akappa(jpi,jpj,2,2), bkappa(jpi,jpj,2,2),                  & 
    60          &        alambd(jpi,jpj,2,2,2,2),                                   & 
     59         &        akappa(jpi,jpj,2,2)     , bkappa(jpi,jpj,2,2),   & 
     60         &        alambd(jpi,jpj,2,2,2,2) ,                        & 
    6161#else 
    62          &        tmv(jpi,jpj), tmf(jpi,jpj), tmi(jpi,jpj),                  & 
     62         &        tmv(jpi,jpj) , tmf(jpi,jpj) , tmi(jpi,jpj) ,     & 
    6363#endif 
    64          &        Stat=ierr(2) ) 
     64         &        STAT=ierr(2) ) 
    6565         ! 
    6666      dom_ice_alloc_2 = MAXVAL(ierr) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90

    r2636 r2690  
    181181      ice_alloc_2 = MAXVAL( ierr ) 
    182182      ! 
    183       IF( ice_alloc_2 /= 0 )   CALL ctl_warn('ice_alloc_2: failed to allocate arrays.') 
     183      IF( ice_alloc_2 /= 0 )   CALL ctl_warn('ice_alloc_2: failed to allocate arrays') 
    184184      ! 
    185185   END FUNCTION ice_alloc_2 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r2677 r2690  
    2121   LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !: 
    2222   INTEGER , PUBLIC ::   nn_cln_update = 3         !: update frequency  
    23    REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.       !: sponge coeff. for tracers 
    24    REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.       !: sponge coeff. for dynamics 
     23   REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.     !: sponge coeff. for tracers 
     24   REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics 
    2525 
    2626   !                                              !!! OLD namelist names 
    … …  
    3131   LOGICAL , PUBLIC :: spongedoneT = .FALSE.   !: tracer   sponge layer indicator 
    3232   LOGICAL , PUBLIC :: spongedoneU = .FALSE.   !: dynamics sponge layer indicator 
    33    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur, spe2vr ,spbtr2, spe1ur2, spe2vr2, spbtr3   !: ??? 
     33 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur , spe2vr , spbtr2   !: ??? 
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur2, spe2vr2, spbtr3   !: ??? 
    3436    
    35    INTEGER :: tn_id,sn_id,tb_id,sb_id,ta_id,sa_id 
     37   INTEGER :: tn_id, sn_id, tb_id, sb_id, ta_id, sa_id 
    3638   INTEGER :: un_id, vn_id, ua_id, va_id 
    3739   INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id 
    3840   INTEGER :: trn_id, trb_id, tra_id 
    3941 
    40    CONTAINS  
     42   !!---------------------------------------------------------------------- 
     43   !! NEMO/NST 3.3.1 , NEMO Consortium (2011) 
     44   !! $Id$ 
     45   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     46   !!---------------------------------------------------------------------- 
     47CONTAINS  
    4148 
    42    FUNCTION agrif_oce_alloc() 
    43      IMPLICIT none 
    44      INTEGER :: agrif_oce_alloc 
    45      INTEGER :: ierr 
    46  
    47      ALLOCATE(spe1ur (jpi,jpj), spe2vr (jpi,jpj), spbtr2(jpi,jpj), & 
    48               spe1ur2(jpi,jpj), spe2vr2(jpi,jpj), spbtr3(jpi,jpj),  & 
    49               Stat = ierr )  
    50  
    51       agrif_oce_alloc = ierr  
    52  
     49   INTEGER FUNCTION agrif_oce_alloc() 
     50      !!---------------------------------------------------------------------- 
     51      !!                ***  FUNCTION agrif_oce_alloc  *** 
     52      !!---------------------------------------------------------------------- 
     53      ALLOCATE( spe1ur (jpi,jpj) , spe2vr (jpi,jpj) , spbtr2(jpi,jpj) ,      & 
     54         &      spe1ur2(jpi,jpj) , spe2vr2(jpi,jpj) , spbtr3(jpi,jpj) , STAT = agrif_oce_alloc )  
    5355   END FUNCTION agrif_oce_alloc 
    5456 
    5557#endif 
    56    !!---------------------------------------------------------------------- 
    57    !! NEMO/NST 3.3 , NEMO Consortium (2010) 
    58    !! $Id$ 
    59    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6058   !!====================================================================== 
    6159END MODULE agrif_oce 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r2677 r2690  
    1616      USE Agrif_Util 
    1717      USE nemogcm 
    18       !! 
    19       IMPLICIT NONE 
    20       !! 
     18      ! 
     19      IMPLICIT NONE 
     20      !!---------------------------------------------------------------------- 
     21      ! 
    2122      IF( .NOT. Agrif_Root() ) THEN 
    2223         jpni = Agrif_Parent(jpni) 
    … …  
    5960      USE obc_par 
    6061#endif 
    61       !! 
    62       IMPLICIT NONE 
    63       !! 
     62      IMPLICIT NONE 
     63      !!---------------------------------------------------------------------- 
    6464 
    6565      ! 0. Initializations 
    … …  
    9191 
    9292# if ! defined key_offline 
     93 
    9394   SUBROUTINE Agrif_InitValues_cont 
    9495      !!---------------------------------------------------------------------- 
    9596      !!                 *** ROUTINE Agrif_InitValues_cont *** 
    9697      !! 
    97       !! ** Purpose :: Declaration of variables to be interpolated 
     98      !! ** Purpose ::   Declaration of variables to be interpolated 
    9899      !!---------------------------------------------------------------------- 
    99100      USE Agrif_Util 
    … …  
    106107      USE agrif_opa_interp 
    107108      USE agrif_opa_sponge 
    108       !! 
    109       IMPLICIT NONE 
    110       !! 
     109      ! 
     110      IMPLICIT NONE 
     111      ! 
    111112      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tabtemp 
    112113      LOGICAL :: check_namelist 
    113114      !!---------------------------------------------------------------------- 
    114115 
    115       ALLOCATE(tabtemp(jpi, jpj, jpk)) 
     116      ALLOCATE( tabtemp(jpi,jpj,jpk) ) 
    116117       
    117118       
    … …  
    144145      
    145146         ! Check time steps            
    146          IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 
     147         IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN 
    147148            WRITE(*,*) 'incompatible time step between grids' 
    148149            WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
    … …  
    153154          
    154155         ! Check run length 
    155          IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    156             Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
     156         IF( Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) /= (nitend-nit000+1) ) THEN 
    157157            WRITE(*,*) 'incompatible run length between grids' 
    158             WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    159                Agrif_Parent(nit000)+1),' time step' 
    160             WRITE(*,*) 'child  grid value : ', & 
    161                (nitend-nit000+1),' time step' 
    162             WRITE(*,*) 'value on child grid should be : ', & 
    163                Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    164                Agrif_Parent(nit000)+1) 
     158            WRITE(*,*) 'parent grid value : ', (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1),' time step' 
     159            WRITE(*,*) 'child  grid value : ', (nitend-nit000+1),' time step' 
     160            WRITE(*,*) 'value on child grid should be: ', Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) 
    165161            STOP 
    166162         ENDIF 
    … …  
    176172               STOP 
    177173            ENDIF           
    178             IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN 
     174            IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN 
    179175               WRITE(*,*) 'incompatible e3zps_rat between grids' 
    180176               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
    … …  
    195191   END SUBROUTINE Agrif_InitValues_cont 
    196192 
     193 
    197194   SUBROUTINE agrif_declare_var 
    198195      !!---------------------------------------------------------------------- 
    … …  
    204201      USE oce 
    205202      IMPLICIT NONE 
     203      !!---------------------------------------------------------------------- 
    206204    
    207205      ! 1. Declaration of the type of variable which have to be interpolated 
    … …  
    294292      USE agrif_top_interp 
    295293      USE agrif_top_sponge 
    296       !! 
    297       IMPLICIT NONE 
    298       !! 
     294      ! 
     295      IMPLICIT NONE 
     296      ! 
    299297      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp 
    300298      LOGICAL :: check_namelist 
    301299      !!---------------------------------------------------------------------- 
    302300 
    303       ALLOCATE(tabtrtemp(jpi, jpj, jpk, jptra)) 
     301      ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) ) 
    304302       
    305303       
    … …  
    332330          
    333331         ! Check run length 
    334          IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    335             Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
     332         IF( Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
    336333            WRITE(*,*) 'incompatible run length between grids' 
    337             WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    338                Agrif_Parent(nit000)+1),' time step' 
    339             WRITE(*,*) 'child  grid value : ', & 
    340                (nitend-nit000+1),' time step' 
    341             WRITE(*,*) 'value on child grid should be : ', & 
    342                Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    343                Agrif_Parent(nit000)+1) 
     334            WRITE(*,*) 'parent grid value : ', (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1),' time step' 
     335            WRITE(*,*) 'child  grid value : ', (nitend-nit000+1),' time step' 
     336            WRITE(*,*) 'value on child grid should be : ', Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) 
    344337            STOP 
    345338         ENDIF 
    … …  
    436429# endif 
    437430    
    438    SUBROUTINE Agrif_detect( g, sizex ) 
     431   SUBROUTINE Agrif_detect( kg, ksizex ) 
    439432      !!---------------------------------------------------------------------- 
    440433      !!   *** ROUTINE Agrif_detect *** 
    441434      !!---------------------------------------------------------------------- 
    442435      USE Agrif_Types 
    443       !!  
    444       INTEGER, DIMENSION(2) :: sizex 
    445       INTEGER, DIMENSION(sizex(1),sizex(2)) :: g  
     436      ! 
     437      INTEGER, DIMENSION(2) :: ksizex 
     438      INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg  
    446439      !!---------------------------------------------------------------------- 
    447440      ! 
    … …  
    458451      USE in_out_manager 
    459452      USE lib_mpp 
    460       !! 
    461       IMPLICIT NONE 
    462       !! 
     453      IMPLICIT NONE 
     454      ! 
    463455      NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn 
    464       INTEGER :: ierr 
    465456      !!---------------------------------------------------------------------- 
    466457      ! 
    … …  
    485476      visc_dyn      = rn_sponge_dyn 
    486477      ! 
    487       ierr = agrif_oce_alloc() 
    488       IF( ierr  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed') 
     478      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed') 
    489479      ! 
    490480    END SUBROUTINE agrif_nemo_init 
    … …  
    497487      !!---------------------------------------------------------------------- 
    498488      USE dom_oce 
    499       !! 
    500       IMPLICIT NONE 
    501       !! 
    502       INTEGER :: indglob,indloc,nprocloc,i 
     489      IMPLICIT NONE 
     490      ! 
     491      INTEGER :: indglob, indloc, nprocloc, i 
    503492      !!---------------------------------------------------------------------- 
    504493      ! 
    … …  
    517506   SUBROUTINE Subcalledbyagrif 
    518507      !!---------------------------------------------------------------------- 
    519       !!   *** ROUTINE Subcalledbyagrif *** 
     508      !!                   *** ROUTINE Subcalledbyagrif *** 
    520509      !!---------------------------------------------------------------------- 
    521510      WRITE(*,*) 'Impossible to be here' 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OFF_SRC/dommsk.F90

    r2655 r2690  
    1212   USE oce             ! ocean dynamics and tracers 
    1313   USE dom_oce         ! ocean space and time domain 
    14    USE lib_mpp 
    15    USE in_out_manager 
     14   USE lib_mpp         ! MPP library 
     15   USE in_out_manager  ! I/O manager 
    1616 
    1717   IMPLICIT NONE 
    … …  
    2020   PUBLIC   dom_msk    ! routine called by inidom.F90 
    2121 
    22    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   facvol  !! volume for degraded regions 
     22   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   facvol   !: volume for degraded regions 
    2323 
    2424   !! * Substitutions 
    … …  
    3131CONTAINS 
    3232 
    33     
    3433   SUBROUTINE dom_msk 
    3534      !!--------------------------------------------------------------------- 
    … …  
    4645      !!               tpol     : ??? 
    4746      !!---------------------------------------------------------------------- 
    48       USE wrk_nemo, ONLY: iwrk_in_use, iwrk_not_released 
    49       USE wrk_nemo, ONLY: imsk => iwrk_2d_1 
     47      USE wrk_nemo, ONLY:   iwrk_in_use, iwrk_not_released 
     48      USE wrk_nemo, ONLY:   imsk => iwrk_2d_1 
     49      ! 
    5050      INTEGER  ::   ji, jk                   ! dummy loop indices 
    5151      INTEGER  ::   iif, iil, ijf, ijl       ! local integers 
    … …  
    5353      ! 
    5454      IF( iwrk_in_use(2, 1) ) THEN 
    55          CALL ctl_stop('dom_msk: ERROR: requested workspace arrays unavailable.')  ;  RETURN 
     55         CALL ctl_stop('dom_msk: requested workspace arrays unavailable')   ;   RETURN 
    5656      END IF 
    5757      ! 
    58       CALL dom_msk_alloc 
     58#if defined key_degrad 
     59      IF( dom_msk_alloc() /= 0 )   CALL ctl_stop('STOP','dom_msk: unable to allocate arrays') 
     60#endif 
    5961 
    6062      ! Interior domain mask (used for global sum) 
    … …  
    99101      ENDIF 
    100102      ! 
    101       IF( iwrk_not_released(2, 1) ) CALL ctl_stop('dom_msk: failed to release workspace arrays.') 
     103      IF( iwrk_not_released(2, 1) )   CALL ctl_stop('dom_msk: failed to release workspace arrays') 
    102104      ! 
    103105   END SUBROUTINE dom_msk 
    104106 
    105    SUBROUTINE dom_msk_alloc() 
     107 
     108   INTEGER FUNCTION dom_msk_alloc() 
    106109      !!--------------------------------------------------------------------- 
    107       !!                 ***  ROUTINE dom_msk_alloc  *** 
     110      !!                 ***  FUNCTION dom_msk_alloc  *** 
    108111      !!--------------------------------------------------------------------- 
    109 #if defined key_degrad 
    110       INTEGER :: ierr  
    111  
    112       ALLOCATE( facvol(jpi,jpj,jpk), STAT=ierr ) 
    113       IF( ierr /= 0 )  & 
    114         &           CALL ctl_stop('STOP', 'dom_msk : unable to allocate facvol array') 
    115 #endif 
    116  
     112      ALLOCATE( facvol(jpi,jpj,jpk) , STAT=dom_msk_alloc ) 
     113      IF( dom_msk_alloc /= 0 )   CALL ctl_warn('dom_msk_alloc : failed to allocate facvol array') 
     114      ! 
    117115   END SUBROUTINE dom_msk_alloc 
    118116 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r2648 r2690  
    296296   END SUBROUTINE dta_dyn 
    297297 
     298 
    298299   INTEGER FUNCTION dta_dyn_alloc() 
    299300      !!--------------------------------------------------------------------- 
    … …  
    302303 
    303304      ALLOCATE( tdta    (jpi,jpj,jpk,2), sdta    (jpi,jpj,jpk,2),    & 
    304        &        udta    (jpi,jpj,jpk,2), vdta    (jpi,jpj,jpk,2),    & 
    305        &        wdta    (jpi,jpj,jpk,2), avtdta  (jpi,jpj,jpk,2),    & 
     305         &      udta    (jpi,jpj,jpk,2), vdta    (jpi,jpj,jpk,2),    & 
     306         &      wdta    (jpi,jpj,jpk,2), avtdta  (jpi,jpj,jpk,2),    & 
    306307#if defined key_ldfslp  
    307        &        uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2),    & 
    308        &        wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2),    & 
     308         &      uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2),    & 
     309         &      wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2),    & 
    309310#endif 
    310311#if defined key_degrad 
    311        &        ahtudta (jpi,jpj,jpk,2), ahtvdta (jpi,jpj,jpk,2),    & 
    312        &        ahtwdta (jpi,jpj,jpk,2),                             & 
     312         &      ahtudta (jpi,jpj,jpk,2), ahtvdta (jpi,jpj,jpk,2),    & 
     313         &      ahtwdta (jpi,jpj,jpk,2),                             & 
    313314# if defined key_traldf_eiv 
    314        &        aeiudta (jpi,jpj,jpk,2), aeivdta (jpi,jpj,jpk,2),    & 
    315        &        aeiwdta (jpi,jpj,jpk,2),                             & 
     315         &      aeiudta (jpi,jpj,jpk,2), aeivdta (jpi,jpj,jpk,2),    & 
     316         &      aeiwdta (jpi,jpj,jpk,2),                             & 
    316317# endif 
    317318#endif 
    318319#if ! defined key_degrad &&  defined key_traldf_c2d && defined key_traldf_eiv 
    319        &        aeiwdta (jpi,jpj,    2),                             & 
    320 #endif 
    321  
    322        &        hmlddta (jpi,jpj,    2), wspddta (jpi,jpj,    2),    & 
    323        &        frlddta (jpi,jpj,    2), qsrdta  (jpi,jpj,    2),    & 
    324        &        empdta  (jpi,jpj,    2),                         STAT=dta_dyn_alloc )  
    325  
    326       IF( dta_dyn_alloc /= 0 ) CALL ctl_warn('dta_dyn_alloc: failed to allocate facvol array.') 
    327  
     320         &      aeiwdta (jpi,jpj,    2),                             & 
     321#endif 
     322         &      hmlddta (jpi,jpj,    2), wspddta (jpi,jpj,    2),    & 
     323         &      frlddta (jpi,jpj,    2), qsrdta  (jpi,jpj,    2),    & 
     324         &      empdta  (jpi,jpj,    2),                         STAT=dta_dyn_alloc )  
     325         ! 
     326      IF( dta_dyn_alloc /= 0 )   CALL ctl_warn('dta_dyn_alloc: failed to allocate facvol array') 
     327      ! 
    328328   END FUNCTION dta_dyn_alloc 
     329 
    329330 
    330331   SUBROUTINE dynrea( kt, kenr ) 
    … …  
    353354      INTEGER ::  jkenr 
    354355      !!---------------------------------------------------------------------- 
    355  
    356       ! 0. Memory allocation 
     356      !  
    357357      IF( wrk_in_use(3, 1,2,3,4,5,6,7,8,9,10,11,12,13) .OR. & 
    358358          wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10)               ) THEN 
    359          CALL ctl_stop('domrea/dta_dyn: requested workspace arrays unavailable')  ;  RETURN 
    360       END IF 
     359         CALL ctl_stop('domrea/dta_dyn: requested workspace arrays unavailable')   ;   RETURN 
     360      ENDIF 
    361361       
    362362      ! cas d'un fichier non periodique : on utilise deux fois le premier et 
    … …  
    488488      IF( wrk_not_released(3, 1,2,3,4,5,6,7,8,9,10,11,12,13) .OR. & 
    489489          wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10)               ) THEN 
    490          CALL ctl_stop('domrea/dta_dyn: failed to release workspace arrays.') 
     490         CALL ctl_stop('domrea/dta_dyn: failed to release workspace arrays') 
    491491      END IF 
    492492      ! 
    … …  
    503503      !!---------------------------------------------------------------------- 
    504504      REAL(wp) :: znspyr   !: number of time step per year 
    505       INTEGER  :: ierr 
    506       !! 
     505      ! 
    507506      NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint, lperdyn,  & 
    508       &                cfile_grid_T, cfile_grid_U, cfile_grid_V, cfile_grid_W 
    509       !!---------------------------------------------------------------------- 
    510  
    511       ierr = dta_dyn_alloc() 
    512       IF( ierr /= 0 )  CALL ctl_stop( 'STOP', 'dta_dyn_alloc : unable to allocate standard ocean arrays' ) 
    513  
    514       !  Define the dynamical input parameters 
    515       ! ====================================== 
    516  
     507         &             cfile_grid_T, cfile_grid_U, cfile_grid_V, cfile_grid_W 
     508      !!---------------------------------------------------------------------- 
     509      ! 
     510      IF( dta_dyn_alloc() /= 0 )  CALL ctl_stop( 'STOP', 'dta_dyn_alloc: unable to allocate standard ocean arrays' ) 
     511      ! 
    517512      REWIND( numnam )              ! Read Namelist namdyn : Lateral physics on tracers 
    518513      READ  ( numnam, namdyn ) 
    519  
     514      ! 
    520515      IF(lwp) THEN                  ! control print 
    521516         WRITE(numout,*) 
    … …  
    537532      ! 
    538533      znspyr   = nyear_len(1) * rday / rdt   
    539       rnspdta  = znspyr / FLOAT( ndtadyn ) 
     534      rnspdta  = znspyr / REAL( ndtadyn, wp ) 
    540535      rnspdta2 = rnspdta * 0.5  
    541536      ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r2669 r2690  
    4141   USE lib_mpp         ! distributed memory computing 
    4242#if defined key_iomput 
    43    USE  mod_ioclient 
     43   USE mod_ioclient 
    4444#endif  
    4545 
    … …  
    165165      ! This used to be done in par_oce.F90 when they were parameters rather 
    166166      ! than variables 
    167       jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci !: first  dim. 
    168       jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj !: second dim. 
    169       jpk = jpkdta                                           !: third dim 
    170       jpim1 = jpi-1                                          !: inner domain indices 
    171       jpjm1 = jpj-1                                          !:   "           " 
    172       jpkm1 = jpk-1                                          !:   "           " 
    173       jpij  = jpi*jpj                                        !:  jpi x j 
     167      jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim. 
     168      jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
     169      jpk = jpkdta                                             ! third dim 
     170      jpim1 = jpi-1                                            ! inner domain indices 
     171      jpjm1 = jpj-1                                            !   "           " 
     172      jpkm1 = jpk-1                                            !   "           " 
     173      jpij  = jpi*jpj                                          !  jpi x j 
    174174 
    175175 
    … …  
    341341   END SUBROUTINE nemo_closefile 
    342342 
     343 
    343344   SUBROUTINE nemo_alloc 
    344      !!---------------------------------------------------------------------- 
    345      !!                     ***  ROUTINE nemo_alloc  *** 
    346      !! 
    347      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules 
    348      !! 
    349      !! ** Method  : 
    350      !!---------------------------------------------------------------------- 
    351      USE diawri,       ONLY: dia_wri_alloc 
    352      USE dom_oce,      ONLY: dom_oce_alloc 
    353      USE zdf_oce,      ONLY: zdf_oce_alloc 
    354      USE zdfmxl,       ONLY: zdf_mxl_alloc 
    355      USE ldftra_oce,   ONLY: ldftra_oce_alloc 
    356      USE trc_oce,      ONLY: trc_oce_alloc 
    357  
     345      !!---------------------------------------------------------------------- 
     346      !!                     ***  ROUTINE nemo_alloc  *** 
     347      !! 
     348      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules 
     349      !! 
     350      !! ** Method  : 
     351      !!---------------------------------------------------------------------- 
     352      USE diawri,       ONLY: dia_wri_alloc 
     353      USE dom_oce,      ONLY: dom_oce_alloc 
     354      USE zdf_oce,      ONLY: zdf_oce_alloc 
     355      USE zdfmxl,       ONLY: zdf_mxl_alloc 
     356      USE ldftra_oce,   ONLY: ldftra_oce_alloc 
     357      USE trc_oce,      ONLY: trc_oce_alloc 
    358358      USE wrk_nemo,    ONLY: wrk_alloc 
    359  
     359      ! 
    360360      INTEGER :: ierr 
    361361      !!---------------------------------------------------------------------- 
    362  
     362      ! 
    363363      ierr =        oce_alloc       ()          ! ocean  
    364364      ierr = ierr + dia_wri_alloc   () 
    … …  
    371371      ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays 
    372372      ierr = ierr + wrk_alloc(numout, lwp) 
    373  
     373      ! 
    374374      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    375       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' ) 
     375      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' ) 
    376376      ! 
    377377   END SUBROUTINE nemo_alloc 
     378 
    378379 
    379380   SUBROUTINE nemo_partition( num_pes ) 
    … …  
    423424   END SUBROUTINE nemo_partition 
    424425 
     426 
    425427   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr ) 
    426428      !!---------------------------------------------------------------------- 
    … …  
    439441      INTEGER, PARAMETER :: ntest = 14 
    440442      INTEGER :: ilfax(ntest) 
    441  
     443      ! 
    442444      ! lfax contains the set of allowed factors. 
    443445      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OFF_SRC/zdfmxl.F90

    r2648 r2690  
    4141      !!               ***  FUNCTION zdf_mxl_alloc  *** 
    4242      !!---------------------------------------------------------------------- 
    43       ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT=zdf_mxl_alloc) 
     43      ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT=zdf_mxl_alloc ) 
    4444      ! 
    4545      IF( lk_mpp             )   CALL mpp_sum ( zdf_mxl_alloc ) 
    46       IF( zdf_mxl_alloc /= 0 )   CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.') 
     46      IF( zdf_mxl_alloc /= 0 )   CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays') 
    4747   END FUNCTION zdf_mxl_alloc 
    4848 
    … …  
    6565      !! ** Action  :   nmln, hmld, hmlp, hmlpt 
    6666      !!---------------------------------------------------------------------- 
    67       USE wrk_nemo, ONLY: iwrk_in_use, iwrk_not_released 
    68       USE wrk_nemo, ONLY: imld => iwrk_2d_1    ! 2D integer workspace 
     67      USE wrk_nemo, ONLY:   iwrk_in_use, iwrk_not_released 
     68      USE wrk_nemo, ONLY:   imld => iwrk_2d_1    ! 2D integer workspace 
    6969      !! 
    70       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     70      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7171      !! 
    72       INTEGER                     ::   ji, jj, jk          ! dummy loop indices 
    73       INTEGER                     ::   iikn, iiki          ! temporary integer within a do loop 
    74       REAL(wp)                    ::   zrho_c = 0.01_wp    ! density criterion for mixed layer depth 
    75       REAL(wp)                    ::   zavt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth 
     72      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
     73      INTEGER  ::   iikn, iiki          ! temporary integer within a do loop 
     74      REAL(wp) ::   zrho_c = 0.01_wp    ! density criterion for mixed layer depth 
     75      REAL(wp) ::   zavt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth 
    7676      !!---------------------------------------------------------------------- 
    7777 
    78       IF( iwrk_in_use(2, 1) )THEN 
     78      IF( iwrk_in_use(2, 1) ) THEN 
    7979         CALL ctl_stop('zdf_mxl : requested workspace array unavailable')   ;   RETURN 
    80       END IF 
     80      ENDIF 
    8181 
    8282      IF( kt == nit000 ) THEN 
    … …  
    112112      IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 ) 
    113113      ! 
    114       IF( iwrk_not_released(2, 1) )   CALL ctl_stop('zdf_mxl : failed to release workspace array') 
     114      IF( iwrk_not_released(2, 1) )   CALL ctl_stop('zdf_mxl: failed to release workspace array') 
    115115      ! 
    116116   END SUBROUTINE zdf_mxl 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r2633 r2690  
    6565      !! ** Purpose :   compute and output some AR5 diagnostics 
    6666      !!---------------------------------------------------------------------- 
    67       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    68       USE wrk_nemo, ONLY: zarea_ssh => wrk_2d_1, zbotpres => wrk_2d_2 
    69       USE wrk_nemo, ONLY: zrhd => wrk_3d_1, zrhop => wrk_3d_2 
    70       USE wrk_nemo, ONLY: ztsn => wrk_4d_1 
    71       !! 
     67      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     68      USE wrk_nemo, ONLY:   zarea_ssh => wrk_2d_1 , zbotpres => wrk_2d_2   ! 2D workspace 
     69      USE wrk_nemo, ONLY:   zrhd      => wrk_3d_1 , zrhop    => wrk_3d_2   ! 3D      - 
     70      USE wrk_nemo, ONLY:   ztsn      => wrk_4d_1                          ! 4D      - 
     71      ! 
    7272      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    73       !! 
     73      ! 
    7474      INTEGER  ::   ji, jj, jk                      ! dummy loop arguments 
    7575      REAL(wp) ::   zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass 
    7676      !!-------------------------------------------------------------------- 
    7777 
    78       IF( wrk_in_use(2, 1,2) .OR. & 
    79           wrk_in_use(3, 1,2) .OR. & 
    80           wrk_in_use(4, 1) )THEN 
     78      IF( wrk_in_use(2, 1,2) .OR.   & 
     79          wrk_in_use(3, 1,2) .OR.   & 
     80          wrk_in_use(4, 1)   ) THEN 
    8181         CALL ctl_stop('dia_ar5: requested workspace arrays unavailable')   ;   RETURN 
    82       END IF 
     82      ENDIF 
    8383 
    8484      CALL iom_put( 'cellthc', fse3t(:,:,:) ) 
    … …  
    160160      CALL iom_put( 'saltot' , zsal  ) 
    161161      ! 
    162       IF( wrk_not_released(2, 1,2) .OR. & 
    163           wrk_not_released(3, 1,2) .OR. & 
    164           wrk_not_released(4, 1) )THEN 
    165          CALL ctl_stop('dia_ar5: failed to release workspace arrays') 
    166       END IF 
     162      IF( wrk_not_released(2, 1,2) .OR.   & 
     163          wrk_not_released(3, 1,2) .OR.   & 
     164          wrk_not_released(4, 1)   )   CALL ctl_stop('dia_ar5: failed to release workspace arrays') 
    167165      ! 
    168166   END SUBROUTINE dia_ar5 
    … …  
    175173      !! ** Purpose :   initialization for AR5 diagnostic computation 
    176174      !!---------------------------------------------------------------------- 
    177       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    178       USE wrk_nemo, ONLY: wrk_4d_1 
    179       !! 
     175      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     176      USE wrk_nemo, ONLY:   wrk_4d_1      ! 4D workspace 
     177      ! 
    180178      INTEGER  ::   inum 
    181179      INTEGER  ::   ik 
    … …  
    185183      !!---------------------------------------------------------------------- 
    186184      ! 
    187       IF(wrk_in_use(4, 1))THEN 
     185      IF(wrk_in_use(4, 1) ) THEN 
    188186         CALL ctl_stop('dia_ar5_init: requested workspace array unavailable.')   ;   RETURN 
    189       END IF 
     187      ENDIF 
    190188      zsaldta => wrk_4d_1(:,:,:,1:2) 
    191189 
    … …  
    223221      ENDIF 
    224222      ! 
    225       IF(wrk_not_released(4, 1))THEN 
    226          CALL ctl_stop('dia_ar5_init: failed to release workspace array.') 
    227       END IF 
     223      IF( wrk_not_released(4, 1) )   CALL ctl_stop('dia_ar5_init: failed to release workspace array') 
    228224      ! 
    229225   END SUBROUTINE dia_ar5_init 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r2633 r2690  
    210210      !!---------------------------------------------------------------------- 
    211211#if defined key_mpp_mpi 
    212       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    213       USE wrk_nemo, ONLY: zwork => wrk_1d_1 
     212      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     213      USE wrk_nemo, ONLY:   zwork => wrk_1d_1 
    214214#endif 
    215215      !! 
    … …  
    265265      ! 
    266266#if defined key_mpp_mpi 
    267       IF(wrk_not_released(1, 1) )   CALL ctl_stop('ptr_vjk: ERROR - failed to release workspace array') 
     267      IF( wrk_not_released(1, 1) )   CALL ctl_stop('ptr_vjk: ERROR - failed to release workspace array') 
    268268#endif 
    269269      ! 
    … …  
    282282      !!---------------------------------------------------------------------- 
    283283#if defined key_mpp_mpi 
    284       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    285       USE wrk_nemo, ONLY: zwork => wrk_1d_1 
     284      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     285      USE wrk_nemo, ONLY:   zwork => wrk_1d_1 
    286286#endif 
    287287      !! 
    … …  
    299299      ! 
    300300#if defined key_mpp_mpi 
    301       IF(wrk_in_use(1, 1))THEN 
    302          CALL ctl_stop('ptr_tjk: requested workspace array unavailable.') 
    303          RETURN 
    304       END IF 
     301      IF( wrk_in_use(1, 1) ) THEN 
     302         CALL ctl_stop('ptr_tjk: requested workspace array unavailable')   ;   RETURN 
     303      ENDIF 
    305304#endif 
    306305 
    … …  
    324323      ! 
    325324#if defined key_mpp_mpi 
    326       IF( wrk_not_released(1, 1) )   CALL ctl_stop('ptr_tjk: failed to release workspace array.') 
     325      IF( wrk_not_released(1, 1) )   CALL ctl_stop('ptr_tjk: failed to release workspace array') 
    327326#endif 
    328327      !     
    … …  
    532531      !! ** Method  :   NetCDF file 
    533532      !!---------------------------------------------------------------------- 
    534       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    535       USE wrk_nemo, ONLY: zphi => wrk_1d_1, zfoo => wrk_1d_2 
    536       USE wrk_nemo, ONLY: z_1  => wrk_2d_1 
     533      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     534      USE wrk_nemo, ONLY:   zphi => wrk_1d_1, zfoo => wrk_1d_2    ! 1D workspace 
     535      USE wrk_nemo, ONLY:   z_1  => wrk_2d_1                      ! 2D      - 
    537536      !! 
    538537      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    … …  
    551550      !!---------------------------------------------------------------------- 
    552551 
    553       IF( wrk_in_use(1, 1,2) .OR. wrk_in_use(2, 1) )THEN 
    554          CALL ctl_stop('dia_ptr_wri: ERROR: requested workspace arrays unavailable')   ;   RETURN 
    555       END IF 
     552      IF( wrk_in_use(1, 1,2) .OR. wrk_in_use(2, 1) ) THEN 
     553         CALL ctl_stop('dia_ptr_wri: requested workspace arrays unavailable')   ;   RETURN 
     554      ENDIF 
    556555 
    557556      ! define time axis 
    … …  
    867866      ENDIF 
    868867      ! 
    869       IF( wrk_not_released(1, 1,2) .OR. wrk_not_released(2, 1) )   & 
    870          CALL ctl_stop('dia_ptr_wri: failed to release workspace arrays') 
     868      IF( wrk_not_released(1, 1,2) .OR.    & 
     869          wrk_not_released(2, 1)    )   CALL ctl_stop('dia_ptr_wri: failed to release workspace arrays') 
    871870      ! 
    872871  END SUBROUTINE dia_ptr_wri 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90

    r2528 r2690  
    4646   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4747   !! $Id$ 
    48    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    49    !!---------------------------------------------------------------------- 
    50  
     48   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     49   !!---------------------------------------------------------------------- 
    5150CONTAINS 
    5251 
    … …  
    181180      REAL(wp)                    ::   zze2 
    182181      REAL(wp), DIMENSION (jpncs) ::   zfwf  
    183   
    184182      !!---------------------------------------------------------------------- 
    185183      ! 
    … …  
    366364         DO jj = ncsj1(jc), ncsj2(jc) 
    367365            DO ji = ncsi1(jc), ncsi2(jc) 
    368                pbat(ji,jj) = 0.e0    
     366               pbat(ji,jj) = 0._wp    
    369367               kbat(ji,jj) = 0    
    370368            END DO  

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90

    r2528 r2690  
    4646   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4747   !! $Id$ 
    48    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     48   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4949   !!---------------------------------------------------------------------- 
    50  
    5150CONTAINS 
    5251 
    … …  
    6867      !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth 
    6968      !!---------------------------------------------------------------------- 
    70       INTEGER :: inbday, idweek 
    71       REAL(wp) :: zjul 
     69      INTEGER  ::  inbday, idweek 
     70      REAL(wp) ::   zjul 
    7271      !!---------------------------------------------------------------------- 
    7372 
    … …  
    129128      CALL day( nit000 ) 
    130129 
    131        
    132130   END SUBROUTINE day_init 
    133131 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r2623 r2690  
    259259      INTEGER, DIMENSION(11) :: ierr 
    260260      !!---------------------------------------------------------------------- 
    261  
    262261      ierr(:) = 0 
    263  
     262      ! 
    264263      ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), STAT=ierr(1) ) 
    265  
     264         ! 
    266265      ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     & 
    267266         &      njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,     & 
    268267         &                                      nleit(jpnij) , nlejt(jpnij) , STAT=ierr(2) ) 
    269  
    270       ALLOCATE( glamt(jpi,jpj), gphit(jpi,jpj), e1t(jpi,jpj), e2t(jpi,jpj),                      &  
    271          &      glamu(jpi,jpj), gphiu(jpi,jpj), e1u(jpi,jpj), e2u(jpi,jpj),                      &   
    272          &      glamv(jpi,jpj), gphiv(jpi,jpj), e1v(jpi,jpj), e2v(jpi,jpj), e1e2t(jpi,jpj) ,     &   
    273          &      glamf(jpi,jpj), gphif(jpi,jpj), e1f(jpi,jpj), e2f(jpi,jpj), ff   (jpi,jpj) , STAT=ierr(3) )      
    274  
     268         ! 
     269      ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) ,                      &  
     270         &      glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) ,                      &   
     271         &      glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , e1e2t(jpi,jpj) ,     &   
     272         &      glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , ff   (jpi,jpj) , STAT=ierr(3) )      
     273         ! 
    275274      ALLOCATE( gdep3w(jpi,jpj,jpk) , e3v(jpi,jpj,jpk) , e3f (jpi,jpj,jpk) ,                         & 
    276275         &      gdept (jpi,jpj,jpk) , e3t(jpi,jpj,jpk) , e3u (jpi,jpj,jpk) ,                         & 
    277276         &      gdepw (jpi,jpj,jpk) , e3w(jpi,jpj,jpk) , e3vw(jpi,jpj,jpk) , e3uw(jpi,jpj,jpk) , STAT=ierr(4) ) 
    278  
     277         ! 
    279278#if defined key_vvl 
    280279      ALLOCATE( gdep3w_1(jpi,jpj,jpk) , e3v_1(jpi,jpj,jpk) , e3f_1 (jpi,jpj,jpk) ,                           & 
    281280         &      gdept_1 (jpi,jpj,jpk) , e3t_1(jpi,jpj,jpk) , e3u_1 (jpi,jpj,jpk) ,                           & 
    282281         &      gdepw_1 (jpi,jpj,jpk) , e3w_1(jpi,jpj,jpk) , e3vw_1(jpi,jpj,jpk) , e3uw_1(jpi,jpj,jpk) ,     & 
    283          &      e3t_b   (jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b(jpi,jpj,jpk)                        , STAT=ierr(5) ) 
    284 #endif 
    285  
     282         &      e3t_b   (jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b (jpi,jpj,jpk)                       , STAT=ierr(5) ) 
     283#endif 
     284         ! 
    286285      ALLOCATE( hu(jpi,jpj) , hur(jpi,jpj) , hu_0(jpi,jpj) ,     & 
    287286         &      hv(jpi,jpj) , hvr(jpi,jpj) , hv_0(jpi,jpj) , STAT=ierr(6) ) 
    288  
     287         ! 
    289288      ALLOCATE( gdept_0(jpk) , gdepw_0(jpk) ,                                     & 
    290289         &      e3t_0  (jpk) , e3w_0  (jpk) , e3tp (jpi,jpj), e3wp(jpi,jpj) ,     & 
    291290         &      gsigt  (jpk) , gsigw  (jpk) , gsi3w(jpk)    ,                     & 
    292291         &      esigt  (jpk) , esigw  (jpk)                                 , STAT=ierr(7) ) 
    293     ! 
     292         ! 
    294293      ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) ,     & 
    295294         &      hbatt (jpi,jpj) , hbatu (jpi,jpj) ,     & 
    … …  
    302301         &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) ) 
    303302 
    304       ALLOCATE( tmask(jpi,jpj,jpk), umask(jpi,jpj,jpk),     &  
    305          &      vmask(jpi,jpj,jpk), fmask(jpi,jpj,jpk), STAT=ierr(10) ) 
     303      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk),     &  
     304         &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk), STAT=ierr(10) ) 
    306305 
    307306#if defined key_noslip_accurate 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90

    r2528 r2690  
    2424   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
    2525   !! $Id$  
    26    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     26   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    2727   !!---------------------------------------------------------------------- 
    28  
    2928CONTAINS 
    3029 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r2651 r2690  
    126126      !!---------------------------------------------------------------------- 
    127127      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
    128       USE wrk_nemo, ONLY:   zwf => wrk_2d_1 
    129       USE wrk_nemo, ONLY:   imsk => iwrk_2d_1 
    130       !! 
     128      USE wrk_nemo, ONLY:   zwf  =>  wrk_2d_1      ! 2D real    workspace 
     129      USE wrk_nemo, ONLY:   imsk => iwrk_2d_1      ! 2D integer workspace 
     130      ! 
    131131      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    132       INTEGER  ::   iif, iil, ii0, ii1, ii 
    133       INTEGER  ::   ijf, ijl, ij0, ij1 
     132      INTEGER  ::   iif, iil, ii0, ii1, ii   ! local integers 
     133      INTEGER  ::   ijf, ijl, ij0, ij1       !   -       - 
    134134      !! 
    135135      NAMELIST/namlbc/ rn_shlat 
    136136      !!--------------------------------------------------------------------- 
    137137       
    138       IF( wrk_in_use(2, 1) .OR. iwrk_in_use(2, 1) )THEN 
    139          CALL ctl_stop('dom_msk: ERROR: requested workspace arrays unavailable')   ;   RETURN 
     138      IF( wrk_in_use(2, 1) .OR. iwrk_in_use(2, 1) ) THEN 
     139         CALL ctl_stop('dom_msk: requested workspace arrays unavailable')   ;   RETURN 
    140140      ENDIF 
    141141 
    … …  
    436436      ENDIF 
    437437      ! 
    438       IF( wrk_not_released(2, 1) .OR.   & 
    439          iwrk_not_released(2, 1)   )   CALL ctl_stop('dom_msk: ERROR: failed to release workspace arrays') 
     438      IF( wrk_not_released(2, 1)  .OR.   & 
     439         iwrk_not_released(2, 1)  )   CALL ctl_stop('dom_msk: failed to release workspace arrays') 
    440440      ! 
    441441   END SUBROUTINE dom_msk 
    … …  
    461461      !!--------------------------------------------------------------------- 
    462462 
    463       IF(lwp)WRITE(numout,*) 
    464       IF(lwp)WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition' 
    465       IF(lwp)WRITE(numout,*) '~~~~~~~~~~~   using Schchepetkin and O Brian scheme' 
     463      IF(lwp) WRITE(numout,*) 
     464      IF(lwp) WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition' 
     465      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   using Schchepetkin and O Brian scheme' 
    466466      IF( lk_mpp )   CALL ctl_stop( ' mpp version is not yet implemented' ) 
    467467 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90

    r2636 r2690  
    88 
    99   !!---------------------------------------------------------------------- 
    10    !!   dom_ngb       : find the closest grid point from a given on/lat position 
     10   !!   dom_ngb       : find the closest grid point from a given lon/lat position 
    1111   !!---------------------------------------------------------------------- 
    12    USE dom_oce         ! ocean space and time domain 
    13    USE lib_mpp         ! for mppsum 
     12   USE dom_oce        ! ocean space and time domain 
     13   USE lib_mpp        ! for mppsum 
    1414 
    1515   IMPLICIT NONE 
    1616   PRIVATE 
    1717 
    18    PUBLIC   dom_ngb    ! routine called in iom.F90 module 
     18   PUBLIC   dom_ngb   ! routine called in iom.F90 module 
    1919 
    2020   !!---------------------------------------------------------------------- 
    … …  
    2929      !!                    ***  ROUTINE dom_ngb  *** 
    3030      !! 
    31       !! ** Purpose :   find the closest grid point from a given on/lat position 
     31      !! ** Purpose :   find the closest grid point from a given lon/lat position 
    3232      !! 
    3333      !! ** Method  :   look for minimum distance in cylindrical projection  
    3434      !!                -> not good if located at too high latitude... 
    35       !! 
    3635      !!---------------------------------------------------------------------- 
    37       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    38       USE wrk_nemo, ONLY: zglam => wrk_2d_2, & 
    39                           zgphi => wrk_2d_3, & 
    40                           zmask => wrk_2d_4, & 
    41                           zdist => wrk_2d_5 
    42       IMPLICIT none 
     36      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     37      USE wrk_nemo, ONLY:   zglam => wrk_2d_2 , zgphi => wrk_2d_3 , zmask => wrk_2d_4 , zdist => wrk_2d_5 
     38      ! 
    4339      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point 
    4440      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point 
    4541      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W' 
    46       !! 
    47       INTEGER , DIMENSION(2)        ::   iloc 
    48       REAL(wp)                      ::   zlon 
    49       REAL(wp)                      ::   zmini 
     42      ! 
     43      INTEGER , DIMENSION(2) ::   iloc 
     44      REAL(wp)               ::   zlon, zmini 
    5045      !!-------------------------------------------------------------------- 
    51  
    52       IF(wrk_in_use(2, 2, 3, 4, 5))THEN 
    53          CALL ctl_stop('dom_ngb: Requested workspaces already in use.') 
    54       END IF 
    55  
    56       zmask(:,:) = 0. 
     46      ! 
     47      IF( wrk_in_use(2, 2,3,4,5) )   CALL ctl_stop('dom_ngb: Requested workspaces already in use') 
     48      ! 
     49      zmask(:,:) = 0._wp 
    5750      SELECT CASE( cdgrid ) 
    5851      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,1) 
    … …  
    7871         kjj = iloc(2) + njmpp - 1 
    7972      ENDIF 
    80  
    81       IF(wrk_not_released(2, 2,3,4,5))THEN 
    82          CALL ctl_stop('dom_ngb: error releasing workspaces.') 
    83       ENDIF 
    84  
     73      ! 
     74      IF( wrk_not_released(2, 2,3,4,5) )   CALL ctl_stop('dom_ngb: error releasing workspaces') 
     75      ! 
    8576   END SUBROUTINE dom_ngb 
    8677 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90

    r2636 r2690  
    5656      !!              - atfp1    : = 1 - 2*atfp 
    5757      !! 
    58       !! References : 
    59       !!      Bryan, K., 1984, J. Phys. Oceanogr., 14, 666-673. 
     58      !! References :   Bryan, K., 1984, J. Phys. Oceanogr., 14, 666-673. 
    6059      !!---------------------------------------------------------------------- 
    6160      INTEGER ::   jk              ! dummy loop indice 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r2679 r2690  
    4848      !!---------------------------------------------------------------------- 
    4949      ! 
    50       ALLOCATE( mut (jpi,jpj,jpk) , muu (jpi,jpj,jpk) , muv (jpi,jpj,jpk) , muf (jpi,jpj,jpk) ,    & 
    51          &      ee_t(jpi,jpj)     , ee_u(jpi,jpj)     , ee_v(jpi,jpj)     , ee_f(jpi,jpj)     ,    & 
    52          &      r2dt(jpk)                                                                     , STAT=dom_vvl_alloc) 
     50      ALLOCATE( mut (jpi,jpj,jpk) , muu (jpi,jpj,jpk) , muv (jpi,jpj,jpk) , muf (jpi,jpj,jpk) ,     & 
     51         &      ee_t(jpi,jpj)     , ee_u(jpi,jpj)     , ee_v(jpi,jpj)     , ee_f(jpi,jpj)     ,     & 
     52         &      r2dt        (jpk)                                                             , STAT=dom_vvl_alloc ) 
    5353         ! 
    5454      IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc ) 
    … …  
    6666      !!---------------------------------------------------------------------- 
    6767      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    68       USE wrk_nemo, ONLY:   zs_t   => wrk_2d_1, zs_u_1 => wrk_2d_2 
    69       USE wrk_nemo, ONLY:   zs_v_1 => wrk_2d_3 
    70       !! 
    71       INTEGER  ::   ji, jj, jk 
     68      USE wrk_nemo, ONLY:   zs_t   => wrk_2d_1 , zs_u_1 => wrk_2d_2 , zs_v_1 => wrk_2d_3     ! 2D workspace 
     69      ! 
     70      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    7271      REAL(wp) ::   zcoefu , zcoefv   , zcoeff                   ! local scalars 
    7372      REAL(wp) ::   zv_t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1   !   -      - 
    7473      !!---------------------------------------------------------------------- 
    7574 
    76       IF(wrk_in_use(2, 1,2,3))THEN 
    77          CALL ctl_stop('dom_vvl: ERROR - requested workspace arrays unavailable.')   ;   RETURN 
    78       END IF 
     75      IF( wrk_in_use(2, 1,2,3) ) THEN 
     76         CALL ctl_stop('dom_vvl: requested workspace arrays unavailable')   ;   RETURN 
     77      ENDIF 
    7978 
    8079      IF(lwp) THEN 
    … …  
    190189      fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:) 
    191190      ! 
    192       IF(wrk_not_released(2, 1,2,3))THEN 
    193          CALL ctl_stop('dom_vvl: ERROR - failed to release workspace arrays.') 
    194       END IF 
     191      IF( wrk_not_released(2, 1,2,3) )   CALL ctl_stop('dom_vvl: failed to release workspace arrays') 
    195192      ! 
    196193   END SUBROUTINE dom_vvl 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    r2633 r2690  
    6363      !!                                   masks, depth and vertical scale factors 
    6464      !!---------------------------------------------------------------------- 
    65       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    66       USE wrk_nemo, ONLY: zprt  => wrk_2d_1, zprw  => wrk_2d_2 
    67       USE wrk_nemo, ONLY: zdepu => wrk_3d_1, zdepv => wrk_3d_2 
     65      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     66      USE wrk_nemo, ONLY:   zprt  => wrk_2d_1 , zprw  => wrk_2d_2    ! 2D workspace 
     67      USE wrk_nemo, ONLY:   zdepu => wrk_3d_1 , zdepv => wrk_3d_2    ! 3D     - 
    6868      !! 
    6969      INTEGER           ::   inum0    ! temprary units for 'mesh_mask.nc' file 
    … …  
    8181 
    8282      IF( wrk_in_use(2, 1,2) .OR. wrk_in_use(3, 1,2) )THEN 
    83          CALL ctl_stop('dom_wri: ERROR - requested workspace arrays unavailable.') 
    84          RETURN 
     83         CALL ctl_stop('dom_wri: requested workspace arrays unavailable')   ;   RETURN 
    8584      END IF 
    8685 
    … …  
    261260      END SELECT 
    262261      ! 
    263       IF( wrk_not_released(2, 1,2) .OR. wrk_not_released(3, 1,2) )THEN 
    264          CALL ctl_stop('dom_wri: ERROR - failed to release workspace arrays.') 
    265       END IF 
     262      IF( wrk_not_released(2, 1,2)  .OR.   & 
     263          wrk_not_released(3, 1,2)  )   CALL ctl_stop('dom_wri: failed to release workspace arrays') 
    266264      ! 
    267265   END SUBROUTINE dom_wri 
    … …  
    277275      !!                2) check which elements have been changed 
    278276      !!---------------------------------------------------------------------- 
    279       !! 
    280       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    281       USE wrk_nemo, ONLY: ztstref => wrk_2d_1      ! array with different values for each element 
    282      !! 
     277      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     278      USE wrk_nemo, ONLY:   ztstref => wrk_2d_1      ! array with different values for each element 
     279      ! 
    283280      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !  
    284281      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !  
    … …  
    290287 
    291288      IF( wrk_in_use(2, 1) ) THEN 
    292          CALL ctl_stop('dom_uniq : requested workspace array unavailable.')   ;   RETURN 
    293          RETURN 
    294       END IF 
     289         CALL ctl_stop('dom_uniq: requested workspace array unavailable')   ;   RETURN 
     290      ENDIF 
    295291 
    296292      ! build an array with different values for each element  
    … …  
    308304      puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 
    309305      ! 
    310       IF( wrk_not_released(2, 1) ) THEN 
    311          CALL ctl_stop('dom_uniq : failed to release workspace array.')   ;   RETURN 
    312       END IF 
     306      IF( wrk_not_released(2, 1) )   CALL ctl_stop('dom_uniq: failed to release workspace array') 
    313307      ! 
    314308   END SUBROUTINE dom_uniq 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r2683 r2690  
    615615      !!---------------------------------------------------------------------- 
    616616      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    617       USE wrk_nemo, ONLY:   zbathy => wrk_2d_1 
     617      USE wrk_nemo, ONLY:   zbathy => wrk_2d_1     ! 2D workspace 
    618618      !! 
    619619      INTEGER ::   ji, jj, jl                    ! dummy loop indices 
    … …  
    745745      !!---------------------------------------------------------------------- 
    746746      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    747       USE wrk_nemo, ONLY:   zmbk => wrk_2d_1 
     747      USE wrk_nemo, ONLY:   zmbk => wrk_2d_1    ! 2D workspace 
    748748      !! 
    749749      INTEGER ::   ji, jj   ! dummy loop indices 
    … …  
    848848      !!---------------------------------------------------------------------- 
    849849      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    850       USE wrk_nemo, ONLY:   zprt => wrk_3d_1 
     850      USE wrk_nemo, ONLY:   zprt => wrk_3d_1    ! 3D workspace 
    851851      !! 
    852852      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    … …  
    861861      !  
    862862      IF( wrk_in_use(3, 1) ) THEN 
    863          CALL ctl_stop('zgr_zps: requested workspace unavailable.')   ;   RETURN 
     863         CALL ctl_stop('zgr_zps: requested workspace unavailable')   ;   RETURN 
    864864      ENDIF 
    865865 
    … …  
    11421142      !!---------------------------------------------------------------------- 
    11431143      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    1144       USE wrk_nemo, ONLY:   zenv => wrk_2d_1 , ztmp => wrk_2d_2 , zmsk  => wrk_2d_3 
    1145       USE wrk_nemo, ONLY:   zri  => wrk_2d_4 , zrj  => wrk_2d_5 , zhbat => wrk_2d_6 
     1144      USE wrk_nemo, ONLY:   zenv => wrk_2d_1 , ztmp => wrk_2d_2 , zmsk  => wrk_2d_3    ! 2D workspace 
     1145      USE wrk_nemo, ONLY:   zri  => wrk_2d_4 , zrj  => wrk_2d_5 , zhbat => wrk_2d_6    !  -      - 
    11461146      ! 
    11471147      INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument 
    … …  
    11531153 
    11541154      IF( wrk_in_use(2, 1,2,3,4,5,6) ) THEN 
    1155          CALL ctl_stop('zgr_sco: ERROR - requested workspace arrays unavailable')   ;   RETURN 
     1155         CALL ctl_stop('zgr_sco: requested workspace arrays unavailable')   ;   RETURN 
    11561156      ENDIF 
    11571157 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r2636 r2690  
    446446      !!                 p=integral [ rau*g dz ] 
    447447      !!---------------------------------------------------------------------- 
    448       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    449       USE wrk_nemo, ONLY: zprn => wrk_3d_1 
     448      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     449      USE wrk_nemo, ONLY:   zprn => wrk_3d_1    ! 3D workspace 
    450450 
    451451      USE dynspg          ! surface pressure gradient             (dyn_spg routine) 
    … …  
    458458      !!---------------------------------------------------------------------- 
    459459 
    460       IF(wrk_in_use(3, 1))THEN 
    461          CALL ctl_stop('istage_uvg: requested workspace array unavailable.') 
    462          RETURN 
    463       END IF 
     460      IF(wrk_in_use(3, 1) ) THEN 
     461         CALL ctl_stop('istage_uvg: requested workspace array unavailable')   ;   RETURN 
     462      ENDIF 
    464463 
    465464      IF(lwp) WRITE(numout,*)  
    … …  
    558557      rotb (:,:,:) = rotn (:,:,:)       ! set the before to the now value 
    559558      ! 
    560       IF(wrk_not_released(3, 1))THEN 
    561          CALL ctl_stop('istage_uvg: failed to release workspace array.') 
    562       END IF 
     559      IF( wrk_not_released(3, 1) ) THEN 
     560         CALL ctl_stop('istage_uvg: failed to release workspace array') 
     561      ENDIF 
    563562      ! 
    564563   END SUBROUTINE istate_uvg 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r2636 r2690  
    9797         IF(lwp) WRITE(numout,*) '~~~~~~~   NOT optimal for auto-tasking case' 
    9898         ! 
    99          ALLOCATE( zwu( jpi, 1:jpj+2) , zwv(-1:jpi+2, jpj) , Stat=ierr ) 
     99         ALLOCATE( zwu( jpi, 1:jpj+2) , zwv(-1:jpi+2, jpj) , STAT=ierr ) 
    100100         IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    101101         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'div_cur : unable to allocate arrays' ) 
    … …  
    273273      !!              - update rotb , rotn , the before & now rel. vorticity 
    274274      !!---------------------------------------------------------------------- 
    275       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    276       ! 
    277       INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    278       REAL(wp) ::  zraur, zdep 
     275      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     276      ! 
     277      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
     278      REAL(wp) ::   zraur, zdep   ! local scalars 
    279279      !!---------------------------------------------------------------------- 
    280280 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90

    r2636 r2690  
    1313   !!---------------------------------------------------------------------- 
    1414   USE dom_oce         ! ocean space and time domain 
    15    USE in_out_manager  ! I/O manager 
    16    USE lib_mpp         ! MPP library 
    17  
    1815   USE dynadv_cen2     ! centred flux form advection      (dyn_adv_cen2 routine) 
    1916   USE dynadv_ubs      ! UBS flux form advection          (dyn_adv_ubs  routine) 
    2017   USE dynkeg          ! kinetic energy gradient          (dyn_keg      routine) 
    2118   USE dynzad          ! vertical advection               (dyn_zad      routine) 
     19   USE in_out_manager  ! I/O manager 
     20   USE lib_mpp         ! MPP library 
    2221 
    2322   IMPLICIT NONE 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

    r2636 r2690  
    1818   USE trdmod         ! ocean dynamics trends 
    1919   USE in_out_manager ! I/O manager 
    20    USE lib_mpp         ! MPP library 
     20   USE lib_mpp        ! MPP library 
    2121   USE prtctl         ! Print control 
    2222 
    … …  
    4848      !!---------------------------------------------------------------------- 
    4949      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    50       USE oce     , ONLY:   zfu   => ta       ! use ta as 3D workspace 
    51       USE oce     , ONLY:   zfv   => sa       ! use sa as 3D workspace 
     50      USE oce     , ONLY:   zfu   => ta       , zfv   => sa       ! (ta,sa) used as 3D workspace 
    5251      USE wrk_nemo, ONLY:   zfu_t => wrk_3d_1 , zfv_t => wrk_3d_4 , zfu_uw =>wrk_3d_6   ! 3D workspaces 
    5352      USE wrk_nemo, ONLY:   zfu_f => wrk_3d_2 , zfv_f => wrk_3d_5 , zfv_vw =>wrk_3d_7 
    5453      USE wrk_nemo, ONLY:   zfw   => wrk_3d_3  
    55       !! 
     54      ! 
    5655      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    57       !! 
     56      ! 
    5857      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    59       REAL(wp) ::   zbu, zbv     ! temporary scalars 
     58      REAL(wp) ::   zbu, zbv     ! local scalars 
    6059      !!---------------------------------------------------------------------- 
    6160 
    … …  
    6968      IF( wrk_in_use(3, 1,2,3,4,5,6,7) ) THEN 
    7069         CALL ctl_stop('dyn_adv_cen2 : requested workspace array unavailable')   ;   RETURN 
    71       END IF 
     70      ENDIF 
    7271 
    7372      IF( l_trddyn ) THEN           ! Save ua and va trends 
    … …  
    163162         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    164163      ! 
    165       IF( wrk_not_released(3, 1,2,3,4,5,6,7) )   CALL ctl_stop('dyn_adv_cen2 : failed to release workspace array') 
     164      IF( wrk_not_released(3, 1,2,3,4,5,6,7) )   CALL ctl_stop('dyn_adv_cen2: failed to release workspace array') 
    166165      ! 
    167166   END SUBROUTINE dyn_adv_cen2 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    r2636 r2690  
    6969      !!---------------------------------------------------------------------- 
    7070      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    71       USE oce     , ONLY:   zfu    => ta       ! ta used as 3D workspace 
    72       USE oce     , ONLY:   zfv    => sa       ! sa used as 3D workspace 
     71      USE oce     , ONLY:   zfu    => ta       , zfv    => sa      ! (ta,sa) used as 3D workspace 
    7372      USE wrk_nemo, ONLY:   zfu_t  => wrk_3d_1 , zfv_t  =>wrk_3d_4 , zfu_uw =>wrk_3d_6   ! 3D workspace 
    7473      USE wrk_nemo, ONLY:   zfu_f  => wrk_3d_2 , zfv_f  =>wrk_3d_5 , zfv_vw =>wrk_3d_7 
    … …  
    9291      ! Check that required workspace arrays are not already in use 
    9392      IF( wrk_in_use(3, 1,2,3,4,5,6,7) .OR. wrk_in_use(4, 1,2,3,4) ) THEN 
    94          CALL ctl_stop('dyn_adv_ubs : requested workspace array unavailable')   ;   RETURN 
     93         CALL ctl_stop('dyn_adv_ubs: requested workspace array unavailable')   ;   RETURN 
    9594      ENDIF 
    9695 
    … …  
    255254         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    256255      ! 
    257       IF( wrk_not_released(3, 1,2,3,4,5,6,7) .OR. & 
    258           wrk_not_released(4, 1,2,3,4)        )   CALL ctl_stop('dyn_adv_ubs : failed to release workspace array') 
     256      IF( wrk_not_released(3, 1,2,3,4,5,6,7) .OR.   & 
     257          wrk_not_released(4, 1,2,3,4)       )   CALL ctl_stop('dyn_adv_ubs: failed to release workspace array') 
    259258      ! 
    260259   END SUBROUTINE dyn_adv_ubs 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90

    r2547 r2690  
    1313   USE dom_oce         ! ocean space and time domain variables  
    1414   USE zdf_oce         ! ocean vertical physics variables 
    15  
    1615   USE trdmod          ! ocean active dynamics and tracers trends  
    1716   USE trdmod_oce      ! ocean variables trends 
    … …  
    4342      !! ** Action  :   (ua,va)   momentum trend increased by bottom friction trend 
    4443      !!--------------------------------------------------------------------- 
    45       USE oce, ONLY :   ztrduv => tsa   ! use tsa as 4D workspace 
     44      USE oce, ONLY:   ztrduv => tsa   ! tsa used as 4D workspace 
    4645      !! 
    4746      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r2636 r2690  
    3131   USE dom_oce         ! ocean space and time domain 
    3232   USE phycst          ! physical constants 
    33    USE in_out_manager  ! I/O manager 
    3433   USE trdmod          ! ocean dynamics trends  
    3534   USE trdmod_oce      ! ocean variables trends 
     35   USE in_out_manager  ! I/O manager 
    3636   USE prtctl          ! Print control 
    3737   USE lbclnk          ! lateral boundary condition  
    … …  
    7777      !!             - Save the trend (l_trddyn=T) 
    7878      !!---------------------------------------------------------------------- 
    79       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    80       USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2   ! 3D workspace 
     79      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     80      USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2   ! 3D workspace 
    8181      !! 
    8282      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    … …  
    193193      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    194194      !!---------------------------------------------------------------------- 
    195       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    196       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     195      USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
    197196      !! 
    198197      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    208207      ENDIF 
    209208       
    210       ! Local constant initialization  
    211       zcoef0 = - grav * 0.5_wp 
     209      zcoef0 = - grav * 0.5_wp      ! Local constant initialization  
    212210 
    213211      ! Surface value 
    … …  
    255253      !! ** Action  : - Update (ua,va) with the now hydrastatic pressure trend 
    256254      !!----------------------------------------------------------------------  
    257       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    258       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     255      USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
    259256      !! 
    260257      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    357354      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    358355      !!---------------------------------------------------------------------- 
    359       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    360       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     356      USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
    361357      !! 
    362358      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    443439      !!             - Save the trend (l_trddyn=T) 
    444440      !!---------------------------------------------------------------------- 
    445       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    446       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     441      USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
    447442      !! 
    448443      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    520515      !! Reference : Song, Mon. Wea. Rev., 126, 3213-3230, 1998. 
    521516      !!---------------------------------------------------------------------- 
    522       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    523       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     517      USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
    524518      !! 
    525519      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    600594      !! Reference: Shchepetkin and McWilliams, J. Geophys. Res., 108(C3), 3090, 2003 
    601595      !!---------------------------------------------------------------------- 
    602       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    603       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
    604       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    605       USE wrk_nemo, ONLY: drhox => wrk_3d_1  , dzx => wrk_3d_2 
    606       USE wrk_nemo, ONLY: drhou => wrk_3d_3  , dzu => wrk_3d_4 , rho_i => wrk_3d_5 
    607       USE wrk_nemo, ONLY: drhoy => wrk_3d_6  , dzy => wrk_3d_7 
    608       USE wrk_nemo, ONLY: drhov => wrk_3d_8  , dzv => wrk_3d_9 , rho_j => wrk_3d_10 
    609       USE wrk_nemo, ONLY: drhoz => wrk_3d_11 , dzz => wrk_3d_12  
    610       USE wrk_nemo, ONLY: drhow => wrk_3d_13 , dzw => wrk_3d_14 
    611       USE wrk_nemo, ONLY: rho_k => wrk_3d_15 
     596      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     597      USE oce     , ONLY:   zhpi  => ta        , zhpj => sa       ! (ta,sa) used as 3D workspace 
     598      USE wrk_nemo, ONLY:   drhox => wrk_3d_1  , dzx  => wrk_3d_2 
     599      USE wrk_nemo, ONLY:   drhou => wrk_3d_3  , dzu  => wrk_3d_4 , rho_i => wrk_3d_5 
     600      USE wrk_nemo, ONLY:   drhoy => wrk_3d_6  , dzy  => wrk_3d_7 
     601      USE wrk_nemo, ONLY:   drhov => wrk_3d_8  , dzv  => wrk_3d_9 , rho_j => wrk_3d_10 
     602      USE wrk_nemo, ONLY:   drhoz => wrk_3d_11 , dzz  => wrk_3d_12  
     603      USE wrk_nemo, ONLY:   drhow => wrk_3d_13 , dzw  => wrk_3d_14 
     604      USE wrk_nemo, ONLY:   rho_k => wrk_3d_15 
    612605      !! 
    613606      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    620613 
    621614      IF( wrk_in_use(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) ) THEN 
    622          CALL ctl_stop('dyn:hpg_djc : requested workspace arrays unavailable')   ;   RETURN 
     615         CALL ctl_stop('dyn:hpg_djc: requested workspace arrays unavailable')   ;   RETURN 
    623616      ENDIF 
    624617 
    … …  
    628621         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, density Jacobian with cubic polynomial scheme' 
    629622      ENDIF 
    630  
    631623 
    632624      ! Local constant initialization 
    … …  
    820812      ! 
    821813      IF( wrk_not_released(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) )   & 
    822          CALL ctl_stop('dyn:hpg_djc : failed to release workspace arrays') 
     814         CALL ctl_stop('dyn:hpg_djc: failed to release workspace arrays') 
    823815      ! 
    824816   END SUBROUTINE hpg_djc 
    … …  
    833825      !! Reference: Thiem & Berntsen, Ocean Modelling, In press, 2005. 
    834826      !!---------------------------------------------------------------------- 
    835       USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    836       USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
    837       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    838       USE wrk_nemo, ONLY: zdistr  => wrk_2d_1 , zsina   => wrk_2d_2 , zcosa  => wrk_2d_3 
    839       USE wrk_nemo, ONLY: zhpiorg => wrk_3d_1 , zhpirot => wrk_3d_2 
    840       USE wrk_nemo, ONLY: zhpitra => wrk_3d_3 , zhpine  => wrk_3d_4 
    841       USE wrk_nemo, ONLY: zhpjorg => wrk_3d_5 , zhpjrot => wrk_3d_6 
    842       USE wrk_nemo, ONLY: zhpjtra => wrk_3d_7 , zhpjne  => wrk_3d_8 
     827      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     828      USE oce     , ONLY:   zhpi    => ta       , zhpj    => sa       ! (ta,sa) used as 3D workspace 
     829      USE wrk_nemo, ONLY:   zdistr  => wrk_2d_1 , zsina   => wrk_2d_2 , zcosa  => wrk_2d_3 
     830      USE wrk_nemo, ONLY:   zhpiorg => wrk_3d_1 , zhpirot => wrk_3d_2 
     831      USE wrk_nemo, ONLY:   zhpitra => wrk_3d_3 , zhpine  => wrk_3d_4 
     832      USE wrk_nemo, ONLY:   zhpjorg => wrk_3d_5 , zhpjrot => wrk_3d_6 
     833      USE wrk_nemo, ONLY:   zhpjtra => wrk_3d_7 , zhpjne  => wrk_3d_8 
    843834      !! 
    844835      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    849840      !!---------------------------------------------------------------------- 
    850841 
    851       IF( wrk_in_use(2, 1,2,3) .OR.      & 
     842      IF( wrk_in_use(2, 1,2,3)             .OR.   & 
    852843          wrk_in_use(3, 1,2,3,4,5,6,7,8) ) THEN 
    853          CALL ctl_stop('dyn:hpg_rot : requested workspace arrays unavailable')   ;   RETURN 
    854       END IF 
     844         CALL ctl_stop('dyn:hpg_rot: requested workspace arrays unavailable')   ;   RETURN 
     845      ENDIF 
    855846 
    856847      IF( kt == nit000 ) THEN 
    … …  
    10091000      END DO 
    10101001      ! 
    1011       IF( wrk_not_released(2, 1,2,3)  .OR.     & 
    1012           wrk_not_released(3, 1,2,3,4,5,6,7,8) )   CALL ctl_stop('dyn:hpg_rot : failed to release workspace arrays') 
     1002      IF( wrk_not_released(2, 1,2,3)           .OR.   & 
     1003          wrk_not_released(3, 1,2,3,4,5,6,7,8) )   CALL ctl_stop('dyn:hpg_rot: failed to release workspace arrays') 
    10131004      ! 
    10141005   END SUBROUTINE hpg_rot 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    r2636 r2690  
    5151      !! ** Purpose :   compute the lateral ocean dynamics physics. 
    5252      !!---------------------------------------------------------------------- 
    53       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    54       USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 
    55       !! 
     53      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     54      USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2 
     55      ! 
    5656      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    5757      !!---------------------------------------------------------------------- 
    5858 
    5959      IF( wrk_in_use(3, 1,2) ) THEN 
    60          CALL ctl_stop('dyn_ldf: requested workspace arrays unavailable.')   ;   RETURN 
     60         CALL ctl_stop('dyn_ldf: requested workspace arrays unavailable')   ;   RETURN 
    6161      ENDIF 
    6262      ! 
    … …  
    110110         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    111111      ! 
    112       IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_ldf: failed to release workspace arrays.') 
     112      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_ldf: failed to release workspace arrays') 
    113113      ! 
    114114   END SUBROUTINE dyn_ldf 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

    r2636 r2690  
    7575      !!---------------------------------------------------------------------- 
    7676      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    77       USE wrk_nemo, ONLY:   zcu => wrk_2d_1, zcv => wrk_2d_2   ! 3D workspace 
    78       USE wrk_nemo, ONLY:   zuf => wrk_3d_1, zut => wrk_3d_2   ! 3D workspace 
    79       USE wrk_nemo, ONLY:   zlu => wrk_3d_3, zlv => wrk_3d_4 
     77      USE wrk_nemo, ONLY:   zcu => wrk_2d_1 , zcv => wrk_2d_2   ! 3D workspace 
     78      USE wrk_nemo, ONLY:   zuf => wrk_3d_1 , zut => wrk_3d_2   ! 3D workspace 
     79      USE wrk_nemo, ONLY:   zlu => wrk_3d_3 , zlv => wrk_3d_4 
    8080      ! 
    8181      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    8282      ! 
    83       INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    84       REAL(wp) ::   zua, zva, zbt, ze2u, ze2v ! temporary scalar 
     83      INTEGER  ::   ji, jj, jk                  ! dummy loop indices 
     84      REAL(wp) ::   zua, zva, zbt, ze2u, ze2v   ! temporary scalar 
    8585      !!---------------------------------------------------------------------- 
    8686 
    … …  
    207207      END DO                                           !   End of slab 
    208208      !                                                ! =============== 
    209       IF( wrk_not_released(2, 1,2)      .OR.   & 
    210           wrk_not_released(3, 1,2,3,4) )   CALL ctl_stop('dyn_ldf_bilap : failed to release workspace arrays') 
     209      IF( wrk_not_released(2, 1,2)     .OR.   & 
     210          wrk_not_released(3, 1,2,3,4) )   CALL ctl_stop('dyn_ldf_bilap: failed to release workspace arrays') 
    211211      ! 
    212212   END SUBROUTINE dyn_ldf_bilap 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    r2636 r2690  
    2020   USE ldfdyn_oce      ! ocean dynamics lateral physics 
    2121   USE zdf_oce         ! ocean vertical physics 
    22    USE in_out_manager  ! I/O manager 
    2322   USE trdmod          ! ocean dynamics trends  
    2423   USE trdmod_oce      ! ocean variables trends 
    2524   USE ldfslp          ! iso-neutral slopes available 
     25   USE in_out_manager  ! I/O manager 
    2626   USE lib_mpp         ! MPP library 
    2727   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    … …  
    5151      !!---------------------------------------------------------------------- 
    5252      ALLOCATE( zfuw(jpi,jpk) , zfvw (jpi,jpk) , zdiu(jpi,jpk) , zdiv (jpi,jpk) ,     & 
    53          &      zdju(jpi,jpk) , zdj1u(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_bilapg_alloc) 
     53         &      zdju(jpi,jpk) , zdj1u(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_bilapg_alloc ) 
    5454         ! 
    5555      IF( dyn_ldf_bilapg_alloc /= 0 )   CALL ctl_warn('dyn_ldf_bilapg_alloc: failed to allocate arrays') 
    … …  
    175175      !!      'key_trddyn' defined: the trend is saved for diagnostics. 
    176176      !!---------------------------------------------------------------------- 
    177       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    178       USE wrk_nemo, ONLY: ziut => wrk_2d_1, zjuf => wrk_2d_2, zjvt => wrk_2d_3 
    179       USE wrk_nemo, ONLY: zivf => wrk_2d_4, zdku => wrk_2d_5, zdk1u => wrk_2d_6 
    180       USE wrk_nemo, ONLY: zdkv => wrk_2d_7, zdk1v => wrk_2d_8 
     177      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     178      USE wrk_nemo, ONLY:   ziut => wrk_2d_1 , zjuf  => wrk_2d_2 , zjvt => wrk_2d_3 
     179      USE wrk_nemo, ONLY:   zivf => wrk_2d_4 , zdku  => wrk_2d_5 , zdk1u => wrk_2d_6 
     180      USE wrk_nemo, ONLY:   zdkv => wrk_2d_7 , zdk1v => wrk_2d_8 
    181181      !! 
    182182      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu , pv    ! 1st call: before horizontal velocity  
    … …  
    195195 
    196196      IF( wrk_in_use(2, 1,2,3,4,5,6,7,8) ) THEN 
    197          CALL ctl_stop('dyn:ldfguv : requested workspace arrays unavailable.')   ;   RETURN 
     197         CALL ctl_stop('dyn:ldfguv: requested workspace arrays unavailable')   ;   RETURN 
    198198      END IF 
    199199      !                               ! ********** !   ! =============== 
    … …  
    452452      !                                                ! =============== 
    453453 
    454       IF( wrk_not_released(2, 1,2,3,4,5,6,7,8) )   CALL ctl_stop('dyn:ldfguv : failed to release workspace arrays') 
     454      IF( wrk_not_released(2, 1,2,3,4,5,6,7,8) )   CALL ctl_stop('dyn:ldfguv: failed to release workspace arrays') 
    455455      ! 
    456456   END SUBROUTINE ldfguv 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90

    r2636 r2690  
    5555      !!---------------------------------------------------------------------- 
    5656      ALLOCATE( zfuw(jpi,jpk) , zdiu(jpi,jpk) , zdju(jpi,jpk) , zdj1u(jpi,jpk) ,     &  
    57          &      zfvw(jpi,jpk) , zdiv(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_iso_alloc) 
     57         &      zfvw(jpi,jpk) , zdiv(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_iso_alloc ) 
    5858         ! 
    5959      IF( dyn_ldf_iso_alloc /= 0 )   CALL ctl_warn('dyn_ldf_iso_alloc: array allocate failed.') 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90

    r2528 r2690  
    44   !! Ocean dynamics:  lateral viscosity trend 
    55   !!====================================================================== 
     6   !! History :  OPA  ! 1990-09 (G. Madec) Original code 
     7   !!            4.0  ! 1991-11 (G. Madec) 
     8   !!            6.0  ! 1996-01 (G. Madec) statement function for e3 and ahm 
     9   !!   NEMO     1.0  ! 2002-06 (G. Madec)  F90: Free form and module 
     10   !!             -   ! 2004-08 (C. Talandier) New trends organization 
     11   !!---------------------------------------------------------------------- 
    612 
    713   !!---------------------------------------------------------------------- 
    … …  
    915   !!                  using an iso-level harmonic operator 
    1016   !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    1217   USE oce             ! ocean dynamics and tracers 
    1318   USE dom_oce         ! ocean space and time domain 
    … …  
    2227   PRIVATE 
    2328 
    24    !! * Routine accessibility 
    2529   PUBLIC dyn_ldf_lap  ! called by step.F90 
    2630 
    … …  
    3236   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3337   !! $Id$  
    34    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3539   !!---------------------------------------------------------------------- 
    36  
    3740CONTAINS 
    3841 
    … …  
    5861      !! ** Action : - Update (ua,va) with the before iso-level harmonic  
    5962      !!               mixing trend. 
    60       !! 
    61       !! History : 
    62       !!        !  90-09 (G. Madec) Original code 
    63       !!        !  91-11 (G. Madec) 
    64       !!        !  96-01 (G. Madec) statement function for e3 and ahm 
    65       !!   8.5  !  02-06 (G. Madec)  F90: Free form and module 
    66       !!   9.0  !  04-08 (C. Talandier) New trends organization 
    6763      !!---------------------------------------------------------------------- 
    68       !! * Arguments 
    69       INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    70  
    71       !! * Local declarations 
    72       INTEGER  ::   ji, jj, jk            ! dummy loop indices 
    73       REAL(wp) ::   & 
    74          zua, zva, ze2u, ze1v             ! temporary scalars 
     64      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     65      ! 
     66      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
     67      REAL(wp) ::   zua, zva, ze2u, ze1v   ! local scalars 
    7568      !!---------------------------------------------------------------------- 
    76  
     69      ! 
    7770      IF( kt == nit000 ) THEN 
    7871         IF(lwp) WRITE(numout,*) 
    … …  
    8073         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    8174      ENDIF 
    82  
    8375      !                                                ! =============== 
    8476      DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    8678         DO jj = 2, jpjm1 
    8779            DO ji = fs_2, fs_jpim1   ! vector opt. 
    88                ze2u = rotb (ji,jj,jk)*fsahmf(ji,jj,jk)*fse3f(ji,jj,jk) 
    89                ze1v = hdivb(ji,jj,jk)*fsahmt(ji,jj,jk) 
     80               ze2u = rotb (ji,jj,jk) * fsahmf(ji,jj,jk) * fse3f(ji,jj,jk) 
     81               ze1v = hdivb(ji,jj,jk) * fsahmt(ji,jj,jk) 
    9082               ! horizontal diffusive trends 
    9183               zua = - ( ze2u - rotb (ji,jj-1,jk)*fsahmf(ji,jj-1,jk)*fse3f(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
    … …  
    10395      END DO                                           !   End of slab 
    10496      !                                                ! =============== 
    105  
    10697   END SUBROUTINE dyn_ldf_lap 
    10798 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r2636 r2690  
    5050   !! * Substitutions 
    5151#  include "domzgr_substitute.h90" 
    52    !!------------------------------------------------------------------------- 
     52   !!---------------------------------------------------------------------- 
    5353   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5454   !! $Id$  
    55    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    56    !!------------------------------------------------------------------------- 
    57  
     55   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     56   !!---------------------------------------------------------------------- 
    5857CONTAINS 
    5958 
    … …  
    9291      !!               un,vn   now horizontal velocity of next time-step 
    9392      !!---------------------------------------------------------------------- 
    94       USE oce, ONLY :   ze3u_f => ta   ! use ta as 3D workspace 
    95       USE oce, ONLY :   ze3v_f => sa   ! use sa as 3D workspace 
    96       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    97       USE wrk_nemo, ONLY:   zs_t => wrk_2d_1, zs_u_1 => wrk_2d_2, & 
    98                           zs_v_1 => wrk_2d_3 
     93      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     94      USE oce     , ONLY:   ze3u_f => ta       , ze3v_f => sa       ! (ta,sa) used as 3D workspace 
     95      USE wrk_nemo, ONLY:   zs_t   => wrk_2d_1 , zs_u_1 => wrk_2d_2 , zs_v_1 => wrk_2d_3 
     96      ! 
    9997      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    100       !! 
     98      ! 
    10199      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    102100#if ! defined key_dynspg_flt 
    103101      REAL(wp) ::   z2dt         ! temporary scalar 
    104102#endif 
    105       REAL(wp) ::   zue3a , zue3n , zue3b    ! temporary scalar 
    106       REAL(wp) ::   zve3a , zve3n , zve3b    !    -         - 
    107       REAL(wp) ::   zuf   , zvf              !    -         -  
    108       REAL(wp) ::   zec                      !    -         -  
    109       REAL(wp) ::   zv_t_ij  , zv_t_ip1j     !     -        - 
    110       REAL(wp) ::   zv_t_ijp1                !     -        - 
     103      REAL(wp) ::   zue3a, zue3n, zue3b, zuf    ! local scalars 
     104      REAL(wp) ::   zve3a, zve3n, zve3b, zvf    !   -      - 
     105      REAL(wp) ::   zec, zv_t_ij, zv_t_ip1j, zv_t_ijp1 
    111106      !!---------------------------------------------------------------------- 
    112107 
    … …  
    163158      CALL obc_dyn( kt ) 
    164159      ! 
    165       IF ( lk_dynspg_exp .OR. lk_dynspg_ts ) THEN 
     160      IF( .NOT. lk_dynspg_flt ) THEN 
    166161         ! Flather boundary condition : - Update sea surface height on each open boundary 
    167          !                                       sshn   (= after ssh   ) for explicit case 
    168          !                                       sshn_b (= after ssha_b) for time-splitting case 
     162         !                                       sshn   (= after ssh   ) for explicit case (lk_dynspg_exp=T) 
     163         !                                       sshn_b (= after ssha_b) for time-splitting case (lk_dynspg_ts=T) 
    169164         !                              - Correct the barotropic velocities 
    170165         CALL obc_dyn_bt( kt ) 
    … …  
    180175# elif defined key_bdy  
    181176      !                                !* BDY open boundaries 
    182       IF( lk_dynspg_exp .OR. lk_dynspg_ts ) THEN       ! except for filtered option 
    183          CALL bdy_dyn_frs( kt ) 
    184       ENDIF 
     177      IF( .NOT. lk_dynspg_flt )   CALL bdy_dyn_frs( kt ) 
    185178# endif 
    186179      ! 
    … …  
    325318         &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask ) 
    326319      !  
    327       IF( wrk_not_released(2, 1,2,3) )   CALL ctl_stop('dyn_nxt: failed to release workspace arrays.') 
     320      IF( wrk_not_released(2, 1,2,3) )   CALL ctl_stop('dyn_nxt: failed to release workspace arrays') 
    328321      ! 
    329322   END SUBROUTINE dyn_nxt 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r2676 r2690  
    7474      !!        of the physical meaning of the results.  
    7575      !!---------------------------------------------------------------------- 
    76       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    77       USE wrk_nemo, ONLY: ztrdu => wrk_3d_4, ztrdv => wrk_3d_5 
    78       !! 
     76      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     77      USE wrk_nemo, ONLY:   ztrdu => wrk_3d_4 , ztrdv => wrk_3d_5    ! 3D workspace 
     78      ! 
    7979      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    8080      INTEGER, INTENT(  out) ::   kindic   ! solver flag 
    81       !! 
     81      ! 
    8282      INTEGER  ::   ji, jj, jk                             ! dummy loop indices 
    8383      REAL(wp) ::   z2dt, zg_2                             ! temporary scalar 
    … …  
    179179 
    180180      !                        ! allocate dyn_spg arrays 
    181       IF( lk_dynspg_ts .AND.dyn_spg_ts_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate ts  arrays') 
     181      IF( lk_dynspg_ts ) THEN 
     182         IF( dynspg_oce_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_oce arrays') 
     183         IF( dyn_spg_ts_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_ts  arrays') 
     184      ENDIF 
    182185 
    183186      !                        ! Control of surface pressure gradient scheme options 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r2618 r2690  
    4040   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4141   !! $Id$ 
    42    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4343   !!---------------------------------------------------------------------- 
    4444CONTAINS 
    … …  
    6161      !!                         the surf. pressure gradient trend 
    6262      !!--------------------------------------------------------------------- 
    63       INTEGER, INTENT( in )  ::   kt         ! ocean time-step index 
     63      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index 
    6464      !! 
    65       INTEGER  ::   ji, jj, jk               ! dummy loop indices 
     65      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    6666      !!---------------------------------------------------------------------- 
    6767 
    … …  
    7171         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   (explicit free surface)' 
    7272         ! 
    73          spgu(:,:) = 0.e0   ;   spgv(:,:) = 0.e0 
     73         spgu(:,:) = 0._wp   ;   spgv(:,:) = 0._wp 
    7474         ! 
    7575         IF( lk_vvl .AND. lwp ) WRITE(numout,*) '              lk_vvl=T : spg is included in dynhpg' 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r2674 r2690  
    6262   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    6363   !! $Id$ 
    64    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     64   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6565   !!---------------------------------------------------------------------- 
    6666CONTAINS 
    … …  
    103103      !! References : Roullet and Madec 1999, JGR. 
    104104      !!--------------------------------------------------------------------- 
    105       USE oce, ONLY :   zub   => ta   ! ta used as workspace 
    106       USE oce, ONLY :   zvb   => sa   ! ta used as workspace 
     105      USE oce, ONLY:   zub   => ta , zvb   => sa   ! (ta,sa) used as workspace 
    107106      !! 
    108107      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    109108      INTEGER, INTENT(  out) ::   kindic   ! solver convergence flag (<0 if not converge) 
    110109      !!                                    
    111       INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    112       REAL(wp) ::   z2dt, z2dtg          ! temporary scalars 
    113       REAL(wp) ::   zgcb, zbtd   !   -          - 
    114       REAL(wp) ::   ztdgu, ztdgv         !   -          - 
     110      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     111      REAL(wp) ::   z2dt, z2dtg, zgcb, zbtd, ztdgu, ztdgv   ! local scalars 
    115112      !!---------------------------------------------------------------------- 
    116113      ! 
    … …  
    121118        
    122119         ! set to zero free surface specific arrays 
    123          spgu(:,:) = 0.e0                     ! surface pressure gradient (i-direction) 
    124          spgv(:,:) = 0.e0                     ! surface pressure gradient (j-direction) 
     120         spgu(:,:) = 0._wp                     ! surface pressure gradient (i-direction) 
     121         spgv(:,:) = 0._wp                     ! surface pressure gradient (j-direction) 
    125122 
    126123         ! read filtered free surface arrays in restart file 
    … …  
    202199      DO jj = 2, jpjm1 
    203200         DO ji = fs_2, fs_jpim1   ! vector opt. 
    204             spgu(ji,jj) = 0.e0 
    205             spgv(ji,jj) = 0.e0 
     201            spgu(ji,jj) = 0._wp 
     202            spgv(ji,jj) = 0._wp 
    206203         END DO 
    207204      END DO 
    … …  
    279276      ncut = 0 
    280277      ! if rnorme is 0, the solution is 0, the solver is not called 
    281       IF( rnorme == 0.e0 ) THEN 
    282          gcx(:,:) = 0.e0 
    283          res   = 0.e0 
     278      IF( rnorme == 0._wp ) THEN 
     279         gcx(:,:) = 0._wp 
     280         res   = 0._wp 
    284281         niter = 0 
    285282         ncut  = 999 
    … …  
    353350 
    354351   SUBROUTINE flt_rst( kt, cdrw ) 
    355      !!--------------------------------------------------------------------- 
    356      !!                   ***  ROUTINE ts_rst  *** 
    357      !! 
    358      !! ** Purpose : Read or write filtered free surface arrays in restart file 
    359      !!---------------------------------------------------------------------- 
    360      INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
    361      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
    362      !!---------------------------------------------------------------------- 
    363  
    364      IF( TRIM(cdrw) == 'READ' ) THEN 
    365         IF( iom_varid( numror, 'gcx', ldstop = .FALSE. ) > 0 ) THEN 
     352      !!--------------------------------------------------------------------- 
     353      !!                   ***  ROUTINE ts_rst  *** 
     354      !! 
     355      !! ** Purpose : Read or write filtered free surface arrays in restart file 
     356      !!---------------------------------------------------------------------- 
     357      INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
     358      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
     359      !!---------------------------------------------------------------------- 
     360      ! 
     361      IF( TRIM(cdrw) == 'READ' ) THEN 
     362         IF( iom_varid( numror, 'gcx', ldstop = .FALSE. ) > 0 ) THEN 
    366363! Caution : extra-hallow 
    367364! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 
    368            CALL iom_get( numror, jpdom_autoglo, 'gcx' , gcx (1:jpi,1:jpj) ) 
    369            CALL iom_get( numror, jpdom_autoglo, 'gcxb', gcxb(1:jpi,1:jpj) ) 
    370            IF( neuler == 0 )   gcxb(:,:) = gcx (:,:) 
    371         ELSE 
    372            gcx (:,:) = 0.e0 
    373            gcxb(:,:) = 0.e0 
    374         ENDIF 
    375      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
     365            CALL iom_get( numror, jpdom_autoglo, 'gcx' , gcx (1:jpi,1:jpj) ) 
     366            CALL iom_get( numror, jpdom_autoglo, 'gcxb', gcxb(1:jpi,1:jpj) ) 
     367            IF( neuler == 0 )   gcxb(:,:) = gcx (:,:) 
     368         ELSE 
     369            gcx (:,:) = 0.e0 
     370            gcxb(:,:) = 0.e0 
     371         ENDIF 
     372      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
    376373! Caution : extra-hallow 
    377374! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 
    378         CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj) ) 
    379         CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) ) 
    380      ENDIF 
    381      ! 
     375         CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj) ) 
     376         CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) ) 
     377      ENDIF 
     378      ! 
    382379   END SUBROUTINE flt_rst 
    383380 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r2636 r2690  
    55   !!                 planetary vorticity trends 
    66   !!====================================================================== 
    7    !! History :  OPA  !  1989-12  (P. Andrich)  vor_ens: Original code 
    8    !!            5.0  !  1991-11  (G. Madec) vor_ene, vor_mix: Original code 
    9    !!            6.0  !  1996-01  (G. Madec)  s-coord, suppress work arrays 
    10    !!            8.5  ! 2002-08  (G. Madec)  F90: Free form and module 
    11    !!   NEMO     1.0  ! 2004-02  (G. Madec)  vor_een: Original code 
    12    !!             -   !  2003-08  (G. Madec)  add vor_ctl 
    13    !!             -   !  2005-11  (G. Madec)  add dyn_vor (new step architecture) 
    14    !!            2.0  !  2006-11  (G. Madec)  flux form advection: add metric term 
    15    !!            3.2  !  2009-04  (R. Benshila)  vvl: correction of een scheme 
    16    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
     7   !! History :  OPA  ! 1989-12  (P. Andrich)  vor_ens: Original code 
     8   !!            5.0  ! 1991-11  (G. Madec) vor_ene, vor_mix: Original code 
     9   !!            6.0  ! 1996-01  (G. Madec)  s-coord, suppress work arrays 
     10   !!   NEMO     0.5  ! 2002-08  (G. Madec)  F90: Free form and module 
     11   !!            1.0  ! 2004-02  (G. Madec)  vor_een: Original code 
     12   !!             -   ! 2003-08  (G. Madec)  add vor_ctl 
     13   !!             -   ! 2005-11  (G. Madec)  add dyn_vor (new step architecture) 
     14   !!            2.0  ! 2006-11  (G. Madec)  flux form advection: add metric term 
     15   !!            3.2  ! 2009-04  (R. Benshila)  vvl: correction of een scheme 
     16   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    1717   !!---------------------------------------------------------------------- 
    1818 
    … …  
    5858   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5959   !! $Id$ 
    60    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     60   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6161   !!---------------------------------------------------------------------- 
    6262CONTAINS 
    … …  
    7171      !!               and planetary vorticity trends) ('key_trddyn') 
    7272      !!---------------------------------------------------------------------- 
    73       USE oce, ONLY :   ztrdu => ta   ! use ta as 3D workspace 
    74       USE oce, ONLY :   ztrdv => sa   ! use sa as 3D workspace 
    75       !! 
     73      USE oce, ONLY:   ztrdu => ta , ztrdv => sa   ! (ta,sa) used as 3D workspace 
     74      ! 
    7675      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    7776      !!---------------------------------------------------------------------- 
    78  
     77      ! 
    7978      !                                          ! vorticity term  
    8079      SELECT CASE ( nvor )                       ! compute the vorticity trend and add it to the general trend 
    … …  
    171170         ! 
    172171      END SELECT 
    173  
     172      ! 
    174173      !                       ! print sum trends (used for debugging) 
    175       IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' vor  - Ua: ', mask1=umask, & 
     174      IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' vor  - Ua: ', mask1=umask,               & 
    176175         &                     tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    177176      ! 
    … …  
    205204      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    206205      !!---------------------------------------------------------------------- 
    207       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    208       USE wrk_nemo, ONLY: zwx => wrk_2d_1, zwy => wrk_2d_2, zwz => wrk_2d_3 
    209       !! 
     206      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     207      USE wrk_nemo, ONLY:   zwx => wrk_2d_1 , zwy => wrk_2d_2 , zwz => wrk_2d_3     ! 2D workspace 
     208      ! 
    210209      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
    211210      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
    … …  
    213212      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua    ! total u-trend 
    214213      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend 
    215       !! 
    216       INTEGER  ::   ji, jj, jk         ! dummy loop indices 
    217       REAL(wp) ::   zx1, zy1, zfact2   ! temporary scalars 
    218       REAL(wp) ::   zx2, zy2           !    "         " 
     214      ! 
     215      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     216      REAL(wp) ::   zx1, zy1, zfact2, zx2, zy2   ! local scalars 
    219217      !!---------------------------------------------------------------------- 
    220218 
    … …  
    286284      END DO                                           !   End of slab 
    287285      !                                                ! =============== 
    288       IF( wrk_not_released(2, 1,2,3) )   CALL ctl_stop('dyn:vor_ene: failed to release workspace arrays.') 
     286      IF( wrk_not_released(2, 1,2,3) )   CALL ctl_stop('dyn:vor_ene: failed to release workspace arrays') 
    289287      ! 
    290288   END SUBROUTINE vor_ene 
    … …  
    322320      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    323321      !!---------------------------------------------------------------------- 
    324       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    325       USE wrk_nemo, ONLY: zwx => wrk_2d_4, zwy => wrk_2d_5, & 
    326                           zwz => wrk_2d_6, zww => wrk_2d_7 
    327       !! 
     322      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     323      USE wrk_nemo, ONLY:   zwx => wrk_2d_4 , zwy => wrk_2d_5 , zwz => wrk_2d_6 , zww => wrk_2d_7   ! 2D workspace 
     324      ! 
    328325      INTEGER, INTENT(in) ::   kt   ! ocean timestep index 
    329       !! 
     326      ! 
    330327      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    331       REAL(wp) ::   zfact1, zua, zcua, zx1, zy1   ! temporary scalars 
    332       REAL(wp) ::   zfact2, zva, zcva, zx2, zy2   !    "         " 
     328      REAL(wp) ::   zfact1, zua, zcua, zx1, zy1   ! local scalars 
     329      REAL(wp) ::   zfact2, zva, zcva, zx2, zy2   !   -      - 
    333330      !!---------------------------------------------------------------------- 
    334331 
    … …  
    438435      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    439436      !!---------------------------------------------------------------------- 
    440       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    441       USE wrk_nemo, ONLY: zwx => wrk_2d_4, zwy => wrk_2d_5, zwz => wrk_2d_6 
    442       !! 
     437      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     438      USE wrk_nemo, ONLY:   zwx => wrk_2d_4, zwy => wrk_2d_5, zwz => wrk_2d_6    ! 2D workspace 
     439      ! 
    443440      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
    444441      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
    … …  
    446443      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua    ! total u-trend 
    447444      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend 
    448       !! 
     445      ! 
    449446      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    450447      REAL(wp) ::   zfact1, zuav, zvau   ! temporary scalars 
    … …  
    452449       
    453450      IF( wrk_in_use(2, 4,5,6) ) THEN 
    454          CALL ctl_stop('dyn:vor_ens : requested workspace arrays unavailable')   ;   RETURN 
     451         CALL ctl_stop('dyn:vor_ens: requested workspace arrays unavailable')   ;   RETURN 
    455452      END IF 
    456453 
    … …  
    526523      END DO                                           !   End of slab 
    527524      !                                                ! =============== 
    528       IF( wrk_not_released(2, 4,5,6) )   CALL ctl_stop('dyn:vor_ens : failed to release workspace arrays') 
     525      IF( wrk_not_released(2, 4,5,6) )   CALL ctl_stop('dyn:vor_ens: failed to release workspace arrays') 
    529526      ! 
    530527   END SUBROUTINE vor_ens 
    … …  
    551548      !!---------------------------------------------------------------------- 
    552549      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    553       USE wrk_nemo, ONLY:   zwx  => wrk_2d_1 , zwy  => wrk_2d_2 ,  zwz => wrk_2d_3  
     550      USE wrk_nemo, ONLY:   zwx  => wrk_2d_1 , zwy  => wrk_2d_2 ,  zwz => wrk_2d_3     ! 2D workspace 
    554551      USE wrk_nemo, ONLY:   ztnw => wrk_2d_4 , ztne => wrk_2d_5  
    555552      USE wrk_nemo, ONLY:   ztsw => wrk_2d_6 , ztse => wrk_2d_7 
    556553#if defined key_vvl 
    557       USE wrk_nemo, ONLY:   ze3f => wrk_3d_1 
     554      USE wrk_nemo, ONLY:   ze3f => wrk_3d_1                                           ! 3D workspace (lk_vvl=T) 
    558555#endif 
    559556      ! 
    … …  
    568565      REAL(wp) ::   zfac12, zua, zva   ! local scalars 
    569566#if ! defined key_vvl 
    570       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE ::   ze3f 
     567      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE ::   ze3f     ! lk_vvl=F, ze3f=1/e3f saved one for all 
    571568#endif 
    572569      !!---------------------------------------------------------------------- 
    573570 
    574571      IF( wrk_in_use(2, 1,2,3,4,5,6,7) .OR. wrk_in_use(3, 1) ) THEN 
    575          CALL ctl_stop('dyn:vor_een : requested workspace arrays unavailable.')   ;   RETURN 
     572         CALL ctl_stop('dyn:vor_een: requested workspace arrays unavailable')   ;   RETURN 
    576573      ENDIF 
    577574 
    … …  
    593590                  ze3f(ji,jj,jk) = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
    594591                     &             + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) * 0.25 
    595                   IF( ze3f(ji,jj,jk) /= 0.e0 )   ze3f(ji,jj,jk) = 1.e0 / ze3f(ji,jj,jk) 
     592                  IF( ze3f(ji,jj,jk) /= 0._wp )   ze3f(ji,jj,jk) = 1._wp / ze3f(ji,jj,jk) 
    596593               END DO 
    597594            END DO 
    … …  
    600597      ENDIF 
    601598 
    602       zfac12 = 1.e0 / 12.e0      ! Local constant initialization 
     599      zfac12 = 1._wp / 12._wp    ! Local constant initialization 
    603600 
    604601       
    … …  
    673670      END DO                                           !   End of slab 
    674671      !                                                ! =============== 
    675       IF(wrk_not_released(2, 1,2,3,4,5,6,7) .OR.   & 
    676          wrk_not_released(3, 1)  )   CALL ctl_stop('dyn:vor_een : failed to release workspace arrays') 
     672      IF( wrk_not_released(2, 1,2,3,4,5,6,7) .OR.   & 
     673          wrk_not_released(3, 1)             )   CALL ctl_stop('dyn:vor_een: failed to release workspace arrays') 
    677674      ! 
    678675   END SUBROUTINE vor_een 
    … …  
    686683      !!              tracer advection schemes 
    687684      !!---------------------------------------------------------------------- 
    688       INTEGER ::   ioptio          ! temporary integer 
     685      INTEGER ::   ioptio          ! local integer 
     686      !! 
    689687      NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een 
    690688      !!---------------------------------------------------------------------- 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r2636 r2690  
    44   !! Ocean dynamics : vertical advection trend 
    55   !!====================================================================== 
    6    !! History :  6.0  !  91-01  (G. Madec) Original code 
    7    !!            7.0  !  91-11  (G. Madec) 
    8    !!            7.5  !  96-01  (G. Madec) statement function for e3 
    9    !!            8.5  !  02-07  (G. Madec) j-k-i case: Original code 
    10    !!            8.5  !  02-07  (G. Madec) Free form, F90 
     6   !! History :  OPA  ! 1991-01  (G. Madec) Original code 
     7   !!            7.0  ! 1991-11  (G. Madec) 
     8   !!            7.5  ! 1996-01  (G. Madec) statement function for e3 
     9   !!   NEMO     0.5  ! 2002-07  (G. Madec) Free form, F90 
    1110   !!---------------------------------------------------------------------- 
    1211    
    … …  
    3433   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3534   !! $Id$ 
    36    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3736   !!---------------------------------------------------------------------- 
    38  
    3937CONTAINS 
    4038 
    … …  
    5553      !!              - Save the trends in (ztrdu,ztrdv) ('key_trddyn') 
    5654     !!---------------------------------------------------------------------- 
    57       USE oce, ONLY:   zwuw => ta   ! use ta as 3D workspace 
    58       USE oce, ONLY:   zwvw => sa   ! use sa as 3D workspace 
    5955      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    60       USE wrk_nemo, ONLY: zww => wrk_2d_1 
    61       USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 
    62       !! 
     56      USE wrk_nemo, ONLY:   zww   => wrk_2d_1                        ! 2D workspace 
     57      USE oce     , ONLY:   zwuw  => ta       , zwvw  => sa          ! (ta,sa) used as 3D workspace 
     58      USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2    ! 3D workspace 
     59      ! 
    6360      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    64       !! 
     61      ! 
    6562      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    6663      REAL(wp) ::   zua, zva        ! temporary scalars 
    6764      !!---------------------------------------------------------------------- 
    6865       
    69       IF( wrk_in_use(2, 1)     .OR.    & 
    70           wrk_in_use(3, 1,2) ) THEN 
     66      IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1,2) ) THEN 
    7167         CALL ctl_stop('dyn_zad: requested workspace arrays unavailable')   ;   RETURN 
    72       END IF 
     68      ENDIF 
    7369 
    7470      IF( kt == nit000 ) THEN 
    … …  
    126122         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    127123      ! 
    128       IF( wrk_not_released(2, 1)       .OR.    & 
     124      IF( wrk_not_released(2, 1)   .OR.   & 
    129125          wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_zad: failed to release workspace arrays') 
    130126      ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90

    r2636 r2690  
    5353      !! ** Purpose :   compute the vertical ocean dynamics physics. 
    5454      !!--------------------------------------------------------------------- 
    55       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    56       USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 
     55      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     56      USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2    ! 3D workspace 
    5757      !! 
    5858      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    5959      !!--------------------------------------------------------------------- 
    6060 
    61       IF(wrk_in_use(3, 1,2))THEN 
    62          CALL ctl_stop('dyn_zdf: requested workspace arrays unavailable.') 
    63          RETURN 
     61      IF( wrk_in_use(3, 1,2) ) THEN 
     62         CALL ctl_stop('dyn_zdf: requested workspace arrays unavailable')   ;   RETURN 
    6463      END IF 
    6564      !                                          ! set time step 
    … …  
    7877      CASE ( 1 )   ;   CALL dyn_zdf_imp( kt, r2dt )      ! implicit scheme 
    7978      ! 
    80       CASE ( -1 )                                      ! esopa: test all possibility with control print 
     79      CASE ( -1 )                                        ! esopa: test all possibility with control print 
    8180                       CALL dyn_zdf_exp( kt, r2dt ) 
    8281                       CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf0 - Ua: ', mask1=umask,               & 
    83             &                        tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     82                          &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    8483                       CALL dyn_zdf_imp( kt, r2dt ) 
    8584                       CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf1 - Ua: ', mask1=umask,               & 
    86             &                        tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     85                          &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    8786      END SELECT 
    8887 
    … …  
    9695            &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    9796      ! 
    98       IF(wrk_not_released(3, 1,2))THEN 
    99          CALL ctl_stop('dyn_zdf: failed to release workspace arrays.') 
    100       END IF 
     97      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_zdf: failed to release workspace arrays') 
    10198      ! 
    10299   END SUBROUTINE dyn_zdf 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90

    r2636 r2690  
    66   !! History :  OPA  !  1990-10  (B. Blanke)  Original code 
    77   !!            8.0  !  1997-05  (G. Madec)  vertical component of isopycnal 
    8    !!   NEMO     1.0  !  1002-08  (G. Madec)  F90: Free form and module 
     8   !!   NEMO     0.5  !  2002-08  (G. Madec)  F90: Free form and module 
    99   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps 
    1010   !!---------------------------------------------------------------------- 
    … …  
    5555      !!--------------------------------------------------------------------- 
    5656      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    57       USE oce     , ONLY :  zwx => ta       , zwy => sa         ! (ta,sa) used as 3D workspace 
     57      USE oce     , ONLY:   zwx => ta       , zwy => sa         ! (ta,sa) used as 3D workspace 
    5858      USE wrk_nemo, ONLY:   zwz => wrk_3d_1 , zww => wrk_3d_2   ! 3D workspace 
    5959      ! 
    … …  
    6161      REAL(wp), INTENT(in) ::   p2dt   ! time-step  
    6262      ! 
    63       INTEGER ::   ji, jj, jk, jl                            ! dummy loop indices 
    64       REAL(wp) ::   zrau0r, zlavmr, zua, zva                 ! temporary scalars 
     63      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
     64      REAL(wp) ::   zrau0r, zlavmr, zua, zva   ! local scalars 
    6565      !!---------------------------------------------------------------------- 
    6666 
    … …  
    120120      END DO                           ! End of time splitting 
    121121      ! 
    122       IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_zdf_exp : failed to release workspace arrays') 
     122      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_zdf_exp: failed to release workspace arrays') 
    123123      ! 
    124124   END SUBROUTINE dyn_zdf_exp 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r2636 r2690  
    11MODULE dynzdf_imp 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                    ***  MODULE  dynzdf_imp  *** 
    44   !! Ocean dynamics:  vertical component(s) of the momentum mixing trend 
    5    !!============================================================================== 
     5   !!====================================================================== 
    66   !! History :  OPA  !  1990-10  (B. Blanke)  Original code 
    77   !!            8.0  !  1997-05  (G. Madec)  vertical component of isopycnal 
    8    !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module 
     8   !!   NEMO     0.5  !  2002-08  (G. Madec)  F90: Free form and module 
    99   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps 
    1010   !!---------------------------------------------------------------------- 
    1111 
    1212   !!---------------------------------------------------------------------- 
    13    !!   dyn_zdf_imp  : update the momentum trend with the vertical diffu- 
    14    !!                  sion using a implicit time-stepping. 
     13   !!   dyn_zdf_imp  : update the momentum trend with the vertical diffusion using a implicit time-stepping 
    1514   !!---------------------------------------------------------------------- 
    1615   USE oce             ! ocean dynamics and tracers 
    … …  
    5554      !! ** Action : - Update (ua,va) arrays with the after vertical diffusive mixing trend. 
    5655      !!--------------------------------------------------------------------- 
    57       USE oce, ONLY :  zwd   => ta      ! use ta as workspace 
    58       USE oce, ONLY :  zws   => sa      ! use sa as workspace 
    59       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    60       USE wrk_nemo, ONLY: zwi => wrk_3d_3 ! workspace 
    61       !! 
    62       INTEGER , INTENT( in ) ::   kt    ! ocean time-step index 
    63       REAL(wp), INTENT( in ) ::  p2dt   ! vertical profile of tracer time-step 
    64       !! 
    65       INTEGER  ::   ji, jj, jk             ! dummy loop indices 
    66       REAL(wp) ::   z1_p2dt, zcoef         ! temporary scalars 
    67       REAL(wp) ::   zzwi, zzws, zrhs       ! temporary scalars 
     56      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     57      USE oce     , ONLY:  zwd  => ta       , zws   => sa   ! (ta,sa) used as 3D workspace 
     58      USE wrk_nemo, ONLY:   zwi => wrk_3d_3                 ! 3D workspace 
     59      !! 
     60      INTEGER , INTENT(in) ::   kt    ! ocean time-step index 
     61      REAL(wp), INTENT(in) ::  p2dt   ! vertical profile of tracer time-step 
     62      !! 
     63      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     64      REAL(wp) ::   z1_p2dt, zcoef, zzwi, zzws, zrhs   ! local scalars 
    6865      !!---------------------------------------------------------------------- 
    6966 
    70       IF(wrk_in_use(3, 3))THEN 
    71          CALL ctl_stop('dyn_zdf_imp : requested workspace array unavailable.') 
    72          RETURN 
     67      IF( wrk_in_use(3, 3) ) THEN 
     68         CALL ctl_stop('dyn_zdf_imp: requested workspace array unavailable')   ;   RETURN 
    7369      END IF 
    7470 
    … …  
    260256      END DO 
    261257      ! 
    262       IF(wrk_not_released(3, 3))THEN 
    263          CALL ctl_stop('dyn_zdf_imp : failed to release workspace array.') 
    264       END IF 
     258      IF( wrk_not_released(3, 3) )   CALL ctl_stop('dyn_zdf_imp: failed to release workspace array') 
    265259      ! 
    266260   END SUBROUTINE dyn_zdf_imp 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r2636 r2690  
    2929   USE obc_oce 
    3030   USE bdy_oce 
    31    USE diaar5, ONLY :   lk_diaar5 
     31   USE diaar5, ONLY:   lk_diaar5 
    3232   USE iom 
    33    USE sbcrnf, ONLY  : h_rnf, nk_rnf  ! River runoff  
     33   USE sbcrnf, ONLY: h_rnf, nk_rnf   ! River runoff  
    3434#if defined key_agrif 
    3535   USE agrif_opa_update 
    … …  
    5252   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5353   !! $Id$ 
    54    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    55    !!---------------------------------------------------------------------- 
    56  
     54   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     55   !!---------------------------------------------------------------------- 
    5756CONTAINS 
    5857 
    … …  
    7675      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
    7776      !!---------------------------------------------------------------------- 
    78       USE oce, ONLY :   z3d => ta   ! use ta as 3D workspace 
    79       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    80       USE wrk_nemo, ONLY: zhdiv => wrk_2d_1, z2d => wrk_2d_2 
    81       !! 
     77      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     78      USE oce     , ONLY:   z3d   => ta                           ! ta used as 3D workspace 
     79      USE wrk_nemo, ONLY:   zhdiv => wrk_2d_1 , z2d => wrk_2d_2   ! 2D workspace 
     80      ! 
    8281      INTEGER, INTENT(in) ::   kt   ! time step 
    83       !! 
    84       INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    85       REAL(wp) ::   zcoefu, zcoefv, zcoeff      ! temporary scalars 
    86       REAL(wp) ::   z2dt, z1_2dt, z1_rau0       ! temporary scalars 
     82      ! 
     83      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     84      REAL(wp) ::   zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0   ! local scalars 
    8785      !!---------------------------------------------------------------------- 
    8886 
    … …  
    9795         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    9896         ! 
    99          wn(:,:,jpk) = 0.e0                   ! bottom boundary condition: w=0 (set once for all) 
     97         wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all) 
    10098         ! 
    10199         IF( lk_vvl ) THEN                    ! before and now Sea SSH at u-, v-, f-points (vvl case only) 
    … …  
    150148         hv(:,:) = hv_0(:,:) + sshv_n(:,:) 
    151149         !                                            ! now masked inverse of the ocean depth (at u- and v-points) 
    152          hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1.e0 - umask(:,:,1) ) 
    153          hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) 
     150         hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1._wp - umask(:,:,1) ) 
     151         hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1._wp - vmask(:,:,1) ) 
    154152         !  
    155153      ENDIF 
    … …  
    157155      CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity 
    158156      ! 
    159       z2dt = 2. * rdt                                 ! set time step size (Euler/Leapfrog) 
    160       IF( neuler == 0 .AND. kt == nit000 )   z2dt =rdt 
     157      z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog) 
     158      IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt 
    161159 
    162160      !                                           !------------------------------! 
    163161      !                                           !   After Sea Surface Height   ! 
    164162      !                                           !------------------------------! 
    165       zhdiv(:,:) = 0.e0 
     163      zhdiv(:,:) = 0._wp 
    166164      DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports 
    167165        zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk) 
    … …  
    171169      ! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp 
    172170      z1_rau0 = 0.5 / rau0 
    173       ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) & 
    174       &                      * tmask(:,:,1) 
     171      ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * tmask(:,:,1) 
    175172 
    176173#if defined key_agrif 
    177       CALL agrif_ssh(kt) 
     174      CALL agrif_ssh( kt ) 
    178175#endif 
    179176#if defined key_obc 
    180177      IF( Agrif_Root() ) THEN  
    181178         ssha(:,:) = ssha(:,:) * obctmsk(:,:) 
    182          CALL lbc_lnk( ssha, 'T', 1. )                ! absolutly compulsory !! (jmm) 
     179         CALL lbc_lnk( ssha, 'T', 1. )                 ! absolutly compulsory !! (jmm) 
    183180      ENDIF 
    184181#endif 
    … …  
    200197            END DO 
    201198         END DO 
    202          ! Boundaries conditions 
    203          CALL lbc_lnk( sshu_a, 'U', 1. ) 
    204          CALL lbc_lnk( sshv_a, 'V', 1. ) 
    205       ENDIF 
    206 ! Include the IAU weighted SSH increment 
     199         CALL lbc_lnk( sshu_a, 'U', 1. )   ;   CALL lbc_lnk( sshv_a, 'V', 1. )      ! Boundaries conditions 
     200      ENDIF 
     201       
    207202#if defined key_asminc 
    208       IF( ( lk_asminc ).AND.( ln_sshinc ).AND.( ln_asmiau ) ) THEN 
     203      !                                                ! Include the IAU weighted SSH increment 
     204      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 
    209205         CALL ssh_asm_inc( kt ) 
    210206         ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 
    … …  
    218214      DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence 
    219215         ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise 
    220          wn(:,:,jk) = wn(:,:,jk+1) -    fse3t_n(:,:,jk) * hdivn(:,:,jk)        & 
    221             &                      - (  fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    & 
     216         wn(:,:,jk) = wn(:,:,jk+1) -   fse3t_n(:,:,jk) * hdivn(:,:,jk)        & 
     217            &                      - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    & 
    222218            &                         * tmask(:,:,jk) * z1_2dt 
    223219#if defined key_bdy 
    … …  
    281277 
    282278      !                       !--------------------------! 
    283       IF( lk_vvl ) THEN       !  Variable volume levels  ! 
     279      IF( lk_vvl ) THEN       !  Variable volume levels  !     (ssh at t-, u-, v, f-points) 
    284280         !                    !--------------------------! 
    285281         ! 
    286          ! ssh at t-, u-, v, f-points 
    287          !=========================== 
    288          IF( neuler == 0 .AND. kt == nit000 ) THEN      ! Euler time-stepping at first time-step : no filter 
    289             sshn  (:,:) = ssha  (:,:)                        ! now <-- after  (before already = now) 
     282         IF( neuler == 0 .AND. kt == nit000 ) THEN    !** Euler time-stepping at first time-step : no filter 
     283            sshn  (:,:) = ssha  (:,:)                       ! now <-- after  (before already = now) 
    290284            sshu_n(:,:) = sshu_a(:,:) 
    291285            sshv_n(:,:) = sshv_a(:,:) 
    292             DO jj = 1, jpjm1 
    293                DO ji = 1, jpim1      ! NO Vector Opt. 
    294                   sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   & 
    295                      &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
    296                      &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
    297                      &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
    298                END DO 
    299             END DO 
    300             ! Boundaries conditions 
    301             CALL lbc_lnk( sshf_n, 'F', 1. ) 
    302          ELSE                                           ! Leap-Frog time-stepping: Asselin filter + swap 
    303             zec = atfp * rdt / rau0 
    304             DO jj = 1, jpj 
    305                DO ji = 1, jpi                                ! before <-- now filtered 
    306                   sshb  (ji,jj) = sshn  (ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) )   & 
    307                      &                          - zec  * ( emp_b(ji,jj) - emp(ji,jj) ) * tmask(ji,jj,1) 
    308                   sshn  (ji,jj) = ssha  (ji,jj)              ! now <-- after 
    309                   sshu_n(ji,jj) = sshu_a(ji,jj) 
    310                   sshv_n(ji,jj) = sshv_a(ji,jj) 
    311                END DO 
    312             END DO 
    313             DO jj = 1, jpjm1 
     286            DO jj = 1, jpjm1                                ! ssh now at f-point 
    314287               DO ji = 1, jpim1      ! NO Vector Opt. 
    315288                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                 & 
    … …  
    319292               END DO 
    320293            END DO 
    321             ! Boundaries conditions 
    322             CALL lbc_lnk( sshf_n, 'F', 1. ) 
    323             DO jj = 1, jpjm1 
     294            CALL lbc_lnk( sshf_n, 'F', 1. )                 ! Boundaries conditions 
     295            ! 
     296         ELSE                                         !** Leap-Frog time-stepping: Asselin filter + swap 
     297            zec = atfp * rdt / rau0 
     298            DO jj = 1, jpj 
     299               DO ji = 1, jpi                               ! before <-- now filtered 
     300                  sshb  (ji,jj) = sshn  (ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) )   & 
     301                     &                          - zec  * ( emp_b(ji,jj) - emp(ji,jj) ) * tmask(ji,jj,1) 
     302                  sshn  (ji,jj) = ssha  (ji,jj)             ! now <-- after 
     303                  sshu_n(ji,jj) = sshu_a(ji,jj) 
     304                  sshv_n(ji,jj) = sshv_a(ji,jj) 
     305               END DO 
     306            END DO 
     307            DO jj = 1, jpjm1                                ! ssh now at f-point 
     308               DO ji = 1, jpim1      ! NO Vector Opt. 
     309                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                 & 
     310                     &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
     311                     &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
     312                     &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
     313               END DO 
     314            END DO 
     315            CALL lbc_lnk( sshf_n, 'F', 1. )                 ! Boundaries conditions 
     316            ! 
     317            DO jj = 1, jpjm1                                ! ssh before at u- & v-points 
    324318               DO ji = 1, jpim1      ! NO Vector Opt. 
    325319                  sshu_b(ji,jj) = 0.5  * umask(ji,jj,1) / ( e1u(ji  ,jj) * e2u(ji  ,jj) )                   & 
    … …  
    331325               END DO 
    332326            END DO 
    333             ! Boundaries conditions 
    334327            CALL lbc_lnk( sshu_b, 'U', 1. ) 
    335             CALL lbc_lnk( sshv_b, 'V', 1. ) 
     328            CALL lbc_lnk( sshv_b, 'V', 1. )            !  Boundaries conditions 
     329            ! 
    336330         ENDIF 
    337331         !                    !--------------------------! 
    338       ELSE                    !        fixed levels      ! 
     332      ELSE                    !        fixed levels      !     (ssh at t-point only) 
    339333         !                    !--------------------------! 
    340334         ! 
    341          ! ssh at t-point only 
    342          !==================== 
    343          IF( neuler == 0 .AND. kt == nit000 ) THEN      ! Euler time-stepping at first time-step : no filter 
    344             sshn(:,:) = ssha(:,:)                            ! now <-- after  (before already = now) 
    345             ! 
    346          ELSE                                           ! Leap-Frog time-stepping: Asselin filter + swap 
     335         IF( neuler == 0 .AND. kt == nit000 ) THEN    !** Euler time-stepping at first time-step : no filter 
     336            sshn(:,:) = ssha(:,:)                           ! now <-- after  (before already = now) 
     337            ! 
     338         ELSE                                               ! Leap-Frog time-stepping: Asselin filter + swap 
    347339            DO jj = 1, jpj 
    348                DO ji = 1, jpi                                ! before <-- now filtered 
     340               DO ji = 1, jpi                               ! before <-- now filtered 
    349341                  sshb(ji,jj) = sshn(ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) ) 
    350                   sshn(ji,jj) = ssha(ji,jj)                  ! now <-- after 
     342                  sshn(ji,jj) = ssha(ji,jj)                 ! now <-- after 
    351343               END DO 
    352344            END DO 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90

    r2618 r2690  
    5656      !!                 ***  FUNCTION flo_oce_alloc  *** 
    5757      !!---------------------------------------------------------------------- 
    58       ALLOCATE( wb(jpi,jpj,jpk), Stat=flo_oce_alloc ) 
     58      ALLOCATE( wb(jpi,jpj,jpk)   , STAT=flo_oce_alloc ) 
    5959      ! 
    6060      IF( lk_mpp             )   CALL mpp_sum ( flo_oce_alloc ) 
    61       IF( flo_oce_alloc /= 0 )   CALL ctl_warn('flo_oce_alloc: failed to allocate arrays.') 
     61      IF( flo_oce_alloc /= 0 )   CALL ctl_warn('flo_oce_alloc: failed to allocate arrays') 
    6262   END FUNCTION flo_oce_alloc 
    6363 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90

    r2633 r2690  
    11MODULE prtctl 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE prtctl   *** 
    4    !! Ocean system   : print all SUM trends for each processor domain 
    5    !!============================================================================== 
     4   !! Ocean system : print all SUM trends for each processor domain 
     5   !!====================================================================== 
     6   !! History :  9.0  !  05-07  (C. Talandier) original code 
     7   !!---------------------------------------------------------------------- 
    68   USE dom_oce          ! ocean space and time domain variables 
    79   USE in_out_manager   ! I/O manager 
    … …  
    1113   PRIVATE 
    1214 
    13    !! * Module declaration 
    14    INTEGER, DIMENSION(:), ALLOCATABLE :: numid 
    15    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   &  !: 
    16       nlditl , nldjtl ,   &  !: first, last indoor index for each i-domain 
    17       nleitl , nlejtl ,   &  !: first, last indoor index for each j-domain 
    18       nimpptl, njmpptl,   &  !: i-, j-indexes for each processor 
    19       nlcitl , nlcjtl ,   &  !: dimensions of every subdomain 
    20       ibonitl, ibonjtl 
    21  
    22    REAL(wp), DIMENSION(:), ALLOCATABLE ::   &  !: 
    23       t_ctll , s_ctll ,   &  !: previous trend values 
    24       u_ctll , v_ctll 
    25  
    26    INTEGER ::   ktime        !: time step 
    27  
    28    !! * Routine accessibility 
     15   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   numid 
     16   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlditl , nldjtl    ! first, last indoor index for each i-domain 
     17   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nleitl , nlejtl    ! first, last indoor index for each j-domain 
     18   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nimpptl, njmpptl   ! i-, j-indexes for each processor 
     19   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlcitl , nlcjtl    ! dimensions of every subdomain 
     20   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   ibonitl, ibonjtl   ! 
     21 
     22   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   t_ctll , s_ctll    ! previous tracer trend values 
     23   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   u_ctll , v_ctll    ! previous velocity trend values 
     24 
     25   INTEGER ::   ktime   ! time step 
     26 
    2927   PUBLIC prt_ctl         ! called by all subroutines 
    3028   PUBLIC prt_ctl_info    ! called by all subroutines 
    3129   PUBLIC prt_ctl_init    ! called by opa.F90 
     30 
    3231   !!---------------------------------------------------------------------- 
    3332   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3433   !! $Id$  
    35    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     34   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3635   !!---------------------------------------------------------------------- 
    37  
    38  
    3936CONTAINS 
    4037 
    41    SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2, mask2, clinfo2, ovlap, kdim, clinfo3) 
     38   SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2,   & 
     39      &                                  mask2, clinfo2, ovlap, kdim, clinfo3 ) 
    4240      !!---------------------------------------------------------------------- 
    4341      !!                     ***  ROUTINE prt_ctl  *** 
    … …  
    7472      !!                    kdim    : k- direction for 3D arrays  
    7573      !!                    clinfo3 : additional information  
    76       !! 
    77       !! History : 
    78       !!   9.0  !  05-07  (C. Talandier) original code 
    79       !!---------------------------------------------------------------------- 
    80       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    81       USE wrk_nemo, ONLY: ztab2d_1 => wrk_2d_1, ztab2d_2 => wrk_2d_2 
    82       USE wrk_nemo, ONLY:   zmask1 => wrk_3d_1,   zmask2 => wrk_3d_2, & 
    83                           ztab3d_1 => wrk_3d_3, ztab3d_2 => wrk_3d_4 
    84       !! * Arguments 
    85       REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL :: tab2d_1 
    86       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_1 
    87       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask1 
    88       CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo1 
    89       REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL :: tab2d_2 
    90       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_2 
    91       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask2 
    92       CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo2 
    93       INTEGER                   , INTENT(in), OPTIONAL :: ovlap 
    94       INTEGER                   , INTENT(in), OPTIONAL :: kdim 
    95       CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo3 
    96  
    97       !! * Local declarations 
    98       INTEGER :: overlap, jn, sind, eind, kdir,j_id 
     74      !!---------------------------------------------------------------------- 
     75      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     76      USE wrk_nemo, ONLY:   ztab2d_1 => wrk_2d_1 , ztab2d_2 => wrk_2d_2 
     77      USE wrk_nemo, ONLY:   zmask1   => wrk_3d_1 , zmask2   => wrk_3d_2  
     78      USE wrk_nemo, ONLY:   ztab3d_1 => wrk_3d_3 , ztab3d_2 => wrk_3d_4 
     79      ! 
     80      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_1 
     81      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_1 
     82      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask1 
     83      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo1 
     84      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_2 
     85      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_2 
     86      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask2 
     87      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo2 
     88      INTEGER                   , INTENT(in), OPTIONAL ::   ovlap 
     89      INTEGER                   , INTENT(in), OPTIONAL ::   kdim 
     90      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo3 
     91      ! 
    9992      CHARACTER (len=15) :: cl2 
     93      INTEGER ::   overlap, jn, sind, eind, kdir,j_id 
    10094      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 
    10195      !!---------------------------------------------------------------------- 
    10296 
    103       IF( wrk_in_use(2, 1,2) .OR. wrk_in_use(3, 1,2,3,4) )THEN 
    104          CALL ctl_stop('prt_ctl : requested workspace arrays unavailable.') 
    105          RETURN 
    106       END IF 
     97      IF( wrk_in_use(2, 1,2) .OR. wrk_in_use(3, 1,2,3,4) ) THEN 
     98         CALL ctl_stop('prt_ctl : requested workspace arrays unavailable')   ;   RETURN 
     99      ENDIF 
    107100 
    108101      ! Arrays, scalars initialization  
    … …  
    122115 
    123116      ! Control of optional arguments 
    124       IF( PRESENT(clinfo2) )  cl2            = clinfo2 
    125       IF( PRESENT(ovlap)   )  overlap        = ovlap 
    126       IF( PRESENT(kdim)    )  kdir           = kdim 
    127       IF( PRESENT(tab2d_1) )  ztab2d_1(:,:)  = tab2d_1(:,:) 
    128       IF( PRESENT(tab2d_2) )  ztab2d_2(:,:)  = tab2d_2(:,:) 
    129       IF( PRESENT(tab3d_1) )  ztab3d_1(:,:,1:kdir)= tab3d_1(:,:,:) 
    130       IF( PRESENT(tab3d_2) )  ztab3d_2(:,:,1:kdir)= tab3d_2(:,:,:) 
    131       IF( PRESENT(mask1)   )  zmask1  (:,:,:)= mask1  (:,:,:) 
    132       IF( PRESENT(mask2)   )  zmask2  (:,:,:)= mask2  (:,:,:) 
    133  
    134       IF( lk_mpp )   THEN 
    135          ! processor number 
     117      IF( PRESENT(clinfo2) )   cl2                  = clinfo2 
     118      IF( PRESENT(ovlap)   )   overlap              = ovlap 
     119      IF( PRESENT(kdim)    )   kdir                 = kdim 
     120      IF( PRESENT(tab2d_1) )   ztab2d_1(:,:)        = tab2d_1(:,:) 
     121      IF( PRESENT(tab2d_2) )   ztab2d_2(:,:)        = tab2d_2(:,:) 
     122      IF( PRESENT(tab3d_1) )   ztab3d_1(:,:,1:kdir) = tab3d_1(:,:,:) 
     123      IF( PRESENT(tab3d_2) )   ztab3d_2(:,:,1:kdir) = tab3d_2(:,:,:) 
     124      IF( PRESENT(mask1)   )   zmask1  (:,:,:)      = mask1  (:,:,:) 
     125      IF( PRESENT(mask2)   )   zmask2  (:,:,:)      = mask2  (:,:,:) 
     126 
     127      IF( lk_mpp ) THEN       ! processor number 
    136128         sind = narea 
    137129         eind = narea 
    138       ELSE 
    139          ! processors total number 
     130      ELSE                    ! processors total number 
    140131         sind = 1 
    141132         eind = ijsplt 
    … …  
    213204      ENDDO 
    214205 
    215       IF( wrk_not_released(2, 1,2) .OR. wrk_not_released(3, 1,2,3,4) )THEN 
    216          CALL ctl_stop('prt_ctl : failed to release workspace arrays.') 
    217       END IF 
    218  
     206      IF( wrk_not_released(2, 1,2)     .OR.   & 
     207          wrk_not_released(3, 1,2,3,4) )   CALL ctl_stop('prt_ctl: failed to release workspace arrays') 
     208      ! 
    219209   END SUBROUTINE prt_ctl 
    220210 
    … …  
    231221      !!                    clinfo2 : information about the ivar2 
    232222      !!                    ivar2   : value to print 
    233       !! 
    234       !! History : 
    235       !!   9.0  !  05-07  (C. Talandier) original code 
    236       !!---------------------------------------------------------------------- 
    237       !! * Arguments 
    238       CHARACTER (len=*), INTENT(in) ::   clinfo1 
     223      !!---------------------------------------------------------------------- 
     224      CHARACTER (len=*), INTENT(in)           ::   clinfo1 
    239225      INTEGER          , INTENT(in), OPTIONAL ::   ivar1 
    240226      CHARACTER (len=*), INTENT(in), OPTIONAL ::   clinfo2 
    241227      INTEGER          , INTENT(in), OPTIONAL ::   ivar2 
    242228      INTEGER          , INTENT(in), OPTIONAL ::   itime 
    243  
    244       !! * Local declarations 
     229      ! 
    245230      INTEGER :: jn, sind, eind, iltime, j_id 
    246231      !!---------------------------------------------------------------------- 
    247232 
    248       IF( lk_mpp )   THEN 
    249          ! processor number 
     233      IF( lk_mpp ) THEN       ! processor number 
    250234         sind = narea 
    251235         eind = narea 
    252       ELSE 
    253          ! total number of processors 
     236      ELSE                    ! total number of processors 
    254237         sind = 1 
    255238         eind = ijsplt 
    … …  
    268251      ! Loop over each sub-domain, i.e. number of processors ijsplt 
    269252      DO jn = sind, eind 
    270           
    271          ! Set logical unit 
    272          j_id = numid(jn - narea + 1) 
    273  
     253         ! 
     254         j_id = numid(jn - narea + 1)         ! Set logical unit 
     255         ! 
    274256         IF( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN 
    275257            WRITE(j_id,*)clinfo1, ivar1, clinfo2, ivar2 
    … …  
    283265            WRITE(j_id,*)clinfo1 
    284266         ENDIF 
    285  
    286       ENDDO 
    287  
    288  
    289       END SUBROUTINE prt_ctl_info 
     267         ! 
     268      END DO 
     269      ! 
     270   END SUBROUTINE prt_ctl_info 
     271 
    290272 
    291273   SUBROUTINE prt_ctl_init 
    … …  
    294276      !! 
    295277      !! ** Purpose :   open ASCII files & compute indices 
    296       !! 
    297       !! History : 
    298       !!   9.0  !  05-07  (C. Talandier) original code 
    299       !!---------------------------------------------------------------------- 
    300       !! * Local declarations 
     278      !!---------------------------------------------------------------------- 
    301279      INTEGER ::   jn, sind, eind, j_id 
    302280      CHARACTER (len=28) :: clfile_out 
    … …  
    306284 
    307285      ! Allocate arrays 
    308       ALLOCATE(nlditl (ijsplt)) 
    309       ALLOCATE(nldjtl (ijsplt)) 
    310       ALLOCATE(nleitl (ijsplt)) 
    311       ALLOCATE(nlejtl (ijsplt)) 
    312       ALLOCATE(nimpptl(ijsplt)) 
    313       ALLOCATE(njmpptl(ijsplt)) 
    314       ALLOCATE(nlcitl (ijsplt)) 
    315       ALLOCATE(nlcjtl (ijsplt)) 
    316       ALLOCATE(t_ctll (ijsplt)) 
    317       ALLOCATE(s_ctll (ijsplt)) 
    318       ALLOCATE(u_ctll (ijsplt)) 
    319       ALLOCATE(v_ctll (ijsplt)) 
    320       ALLOCATE(ibonitl(ijsplt)) 
    321       ALLOCATE(ibonjtl(ijsplt)) 
     286      ALLOCATE( nlditl(ijsplt) , nleitl(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) ,   & 
     287         &      nldjtl(ijsplt) , nlejtl(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) ,   & 
     288         &      nlcitl(ijsplt) , t_ctll(ijsplt) , u_ctll (ijsplt) ,                     & 
     289         &      nlcjtl(ijsplt) , s_ctll(ijsplt) , v_ctll (ijsplt)                       ) 
    322290 
    323291      ! Initialization  
    324       t_ctll(:)=0.e0 
    325       s_ctll(:)=0.e0 
    326       u_ctll(:)=0.e0 
    327       v_ctll(:)=0.e0 
     292      t_ctll(:) = 0.e0 
     293      s_ctll(:) = 0.e0 
     294      u_ctll(:) = 0.e0 
     295      v_ctll(:) = 0.e0 
    328296      ktime = 1 
    329297 
    … …  
    356324      ENDIF 
    357325 
    358       ALLOCATE(numid(eind-sind+1)) 
     326      ALLOCATE( numid(eind-sind+1) ) 
    359327 
    360328      DO jn = sind, eind 
    … …  
    4033719003     FORMAT(a20,i4.4,a17,i4.4) 
    4043729004     FORMAT(a11,i4.4,a26,i4.4,a14) 
    405       ENDDO 
    406  
     373      END DO 
     374      ! 
    407375   END SUBROUTINE prt_ctl_init 
    408376 
    … …  
    445413      !!   8.5  !  02-08  (G. Madec)  F90 : free form 
    446414      !!---------------------------------------------------------------------- 
    447       !! * Local variables 
    448415      INTEGER ::   ji, jj, jn               ! dummy loop indices 
    449416      INTEGER ::   & 
    … …  
    454421         nrecil, nrecjl, nldil, nleil, nldjl, nlejl 
    455422 
    456       INTEGER, DIMENSION(:,:), ALLOCATABLE ::   & 
    457          iimpptl, ijmpptl, ilcitl, ilcjtl       ! temporary workspace 
     423      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace 
    458424      REAL(wp) ::   zidom, zjdom            ! temporary scalars 
    459425      !!---------------------------------------------------------------------- 
    … …  
    575541         nlejtl(jn) = nlejl 
    576542      END DO 
    577  
    578       DEALLOCATE(iimpptl) 
    579       DEALLOCATE(ijmpptl) 
    580       DEALLOCATE(ilcitl) 
    581       DEALLOCATE(ilcjtl) 
    582  
     543      ! 
     544      DEALLOCATE( iimpptl, ijmpptl, ilcitl, ilcjtl ) 
     545      ! 
    583546   END SUBROUTINE sub_dom 
    584547 
     548   !!====================================================================== 
    585549END MODULE prtctl 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r2668 r2690  
    17591759      !!---------------------------------------------------------------------- 
    17601760 
    1761       IF(wrk_in_use(2, 1) ) THEN 
     1761      IF( wrk_in_use(2, 1) ) THEN 
    17621762         WRITE(kumout, cform_err) 
    17631763         WRITE(kumout,*) 'mppobc : requested workspace array unavailable' 
    17641764         CALL mppstop 
    1765       END IF 
     1765      ENDIF 
    17661766 
    17671767      ! boundary condition initialization 
    … …  
    19141914      END DO 
    19151915      ! 
    1916       IF(wrk_not_released(2, 1) ) THEN 
     1916      IF( wrk_not_released(2, 1) ) THEN 
    19171917         WRITE(kumout, cform_err) 
    19181918         WRITE(kumout,*) 'mppobc : failed to release workspace array' 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r2442 r2690  
    2020   PRIVATE 
    2121 
    22    !! * Routine accessibility 
    2322   PUBLIC mpp_init       ! called by opa.F90 
    2423   PUBLIC mpp_init2      ! called by opa.F90 
    … …  
    2928   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3029   !! $Id$  
    31    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    32    !!---------------------------------------------------------------------- 
    33  
     30   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     31   !!---------------------------------------------------------------------- 
    3432CONTAINS 
    3533 
    … …  
    128126      !!   8.5  !  02-08  (G. Madec)  F90 : free form 
    129127      !!---------------------------------------------------------------------- 
    130       !! * Local variables 
    131       INTEGER ::   ji, jj, jn               ! dummy loop indices 
    132       INTEGER ::   & 
    133          ii, ij, ifreq, il1, il2,        &  ! temporary integers 
    134          iresti, irestj, ijm1, imil,     &  !    "          " 
    135          inum                               ! temporary logical unit 
    136  
    137       INTEGER, DIMENSION(jpni,jpnj) ::   & 
    138          iimppt, ijmppt, ilcit, ilcjt       ! temporary workspace 
    139       REAL(wp) ::   zidom, zjdom            ! temporary scalars 
     128      INTEGER  ::   ji, jj, jn   ! dummy loop indices 
     129      INTEGER  ::   ii, ij, ifreq, il1, il2            ! local integers 
     130      INTEGER  ::   iresti, irestj, ijm1, imil, inum   !   -      - 
     131      REAL(wp) ::   zidom, zjdom                       ! local scalars 
     132      INTEGER, DIMENSION(jpni,jpnj) ::   iimppt, ijmppt, ilcit, ilcjt   ! local workspace 
    140133      !!---------------------------------------------------------------------- 
    141134 
    … …  
    451444      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij 
    452445      !!---------------------------------------------------------------------- 
    453       !! Local declarations 
    454  
    455       INTEGER, DIMENSION(2) ::   & 
    456          iglo, iloc, iabsf, iabsl, ihals, ihale, idid 
     446      INTEGER, DIMENSION(2) ::   iglo, iloc, iabsf, iabsl, ihals, ihale, idid 
    457447      !!---------------------------------------------------------------------- 
    458448 
    … …  
    482472          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2) 
    483473      ENDIF 
    484  
     474      ! 
    485475      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom) 
    486  
     476      ! 
    487477   END SUBROUTINE mpp_init_ioipsl   
    488478 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90

    r2590 r2690  
    3838   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3939   !! $Id$  
    40    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    41    !!---------------------------------------------------------------------- 
    42  
     40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     41   !!---------------------------------------------------------------------- 
    4342CONTAINS 
    4443 
    … …  
    6362      !!---------------------------------------------------------------------- 
    6463      INTEGER ::   ioptio         ! ??? 
    65       LOGICAL :: ll_print = .FALSE.    ! Logical flag for printing viscosity coef. 
     64      LOGICAL ::   ll_print = .FALSE.    ! Logical flag for printing viscosity coef. 
    6665      !!  
    6766      NAMELIST/namdyn_ldf/ ln_dynldf_lap  , ln_dynldf_bilap,                  & 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90

    r2528 r2690  
    2424      !! 
    2525      !!---------------------------------------------------------------------- 
    26       !! * Arguments 
    27       LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    28  
    29       !! * Local variables 
     26      LOGICAL, INTENT(in) :: ld_print   ! If true, output arrays on numout 
     27      ! 
    3028      INTEGER  ::   jk   ! dummy loop indice 
    3129      REAL(wp) ::   zdam,  zwam,  zm00,  zm01,  zmhf,  zmhs 
    … …  
    3735      IF(lwp) WRITE(numout,*) 'inildf: 1D eddy viscosity coefficient' 
    3836      IF(lwp) WRITE(numout,*) '~~~~~~  --' 
    39       IF(lwp) WRITE(numout,*) 
    4037 
    4138      ! Set ahm1 for laplacian     (always at t-level) 
    … …  
    124121      ENDIF 
    125122 9120 FORMAT('  jk      ahm       ','  depth w-level ' ) 
    126  
     123      ! 
    127124   END SUBROUTINE ldf_dyn_c1d 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90

    r2633 r2690  
    3232      !! 
    3333      !!---------------------------------------------------------------------- 
    34       !! * Arguments 
    3534      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    36  
    37       !! * Local variables 
    38       INTEGER :: ji, jj 
     35      ! 
     36      INTEGER  ::   ji, jj 
    3937      REAL(wp) ::   za00, zd_max, zetmax, zeumax, zefmax, zevmax 
    4038      !!---------------------------------------------------------------------- 
    … …  
    4341      IF(lwp) WRITE(numout,*) 'ldf_dyn_c2d : 2d lateral eddy viscosity coefficient' 
    4442      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    45       IF(lwp) WRITE(numout,*) 
    4643 
    4744      ! harmonic operator (ahm1, ahm2) : ( T- and F- points) (used for laplacian operators 
    … …  
    123120         ENDIF 
    124121      ENDIF 
    125  
    126  
     122      ! 
    127123   END SUBROUTINE ldf_dyn_c2d 
    128124 
    … …  
    143139      !! 
    144140      !!---------------------------------------------------------------------- 
    145       !! * Modules used 
    146       USE ldftra_oce, ONLY : aht0 
    147       USE wrk_nemo, ONLY: iwrk_in_use, iwrk_not_released 
    148       USE wrk_nemo, ONLY: icof => iwrk_2d_1 
    149       !! * Arguments 
     141      USE ldftra_oce, ONLY:   aht0 
     142      USE wrk_nemo  , ONLY:   iwrk_in_use, iwrk_not_released 
     143      USE wrk_nemo  , ONLY:   icof => iwrk_2d_1 
     144      ! 
    150145      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
    151  
    152       !! * Local variables 
    153       INTEGER ::   ji, jj, jn      ! dummy loop indices 
    154       INTEGER ::   inum            ! temporary logical unit 
    155       INTEGER ::   iim, ijm 
    156       INTEGER ::   ifreq, il1, il2, ij, ii 
     146      ! 
     147      INTEGER  ::   ji, jj, jn   ! dummy loop indices 
     148      INTEGER  ::   inum, iim, ijm            ! local integers 
     149      INTEGER  ::   ifreq, il1, il2, ij, ii 
     150      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk 
     151      CHARACTER (len=15) ::   clexp 
    157152      INTEGER, DIMENSION(jpidta,jpidta) ::   idata 
    158  
    159       REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk 
    160  
    161       CHARACTER (len=15) ::   clexp 
    162153      !!---------------------------------------------------------------------- 
    163154 
    164155      IF( iwrk_in_use(2, 1) )THEN 
    165          CALL ctl_stop('ldf_dyn_c2d_orca: ERROR: requested workspace array is unavailable.') 
    166          RETURN 
    167       END IF 
     156         CALL ctl_stop('ldf_dyn_c2d_orca: requested workspace array is unavailable')   ;   RETURN 
     157      ENDIF 
    168158 
    169159      IF(lwp) WRITE(numout,*) 
    170160      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient' 
    171161      IF(lwp) WRITE(numout,*) '~~~~~~  --' 
    172       IF(lwp) WRITE(numout,*) 
    173       IF(lwp) WRITE(numout,*) '        orca ocean model' 
    174       IF(lwp) WRITE(numout,*) 
     162      IF(lwp) WRITE(numout,*) '        orca ocean configuration' 
    175163 
    176164#if defined key_antarctic 
    … …  
    293281      ENDIF 
    294282 
    295       IF( iwrk_not_released(2, 1) )THEN 
    296          CALL ctl_stop('ldf_dyn_c2d_orca: ERROR: failed to release workspace array.') 
     283      IF( iwrk_not_released(2, 1) )   CALL ctl_stop('ldf_dyn_c2d_orca: failed to release workspace array') 
    297284      END IF 
    298  
     285      ! 
    299286   END SUBROUTINE ldf_dyn_c2d_orca 
     287 
    300288 
    301289   SUBROUTINE ldf_dyn_c2d_orca_R1( ld_print ) 
    … …  
    314302      !! 
    315303      !!---------------------------------------------------------------------- 
    316       !! * Modules used 
    317       USE ldftra_oce, ONLY : aht0 
    318       USE wrk_nemo, ONLY: iwrk_in_use, iwrk_not_released 
    319       USE wrk_nemo, ONLY: icof => iwrk_2d_1 
    320  
    321       !! * Arguments 
     304      USE ldftra_oce, ONLY:   aht0 
     305      USE wrk_nemo  , ONLY:   iwrk_in_use, iwrk_not_released 
     306      USE wrk_nemo  , ONLY:   icof => iwrk_2d_1 
     307      ! 
    322308      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
    323  
    324       !! * Local variables 
     309      ! 
    325310      INTEGER ::   ji, jj, jn      ! dummy loop indices 
    326311      INTEGER ::   inum            ! temporary logical unit 
    327312      INTEGER ::   iim, ijm 
    328313      INTEGER ::   ifreq, il1, il2, ij, ii 
     314      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk, zam20s 
     315      CHARACTER (len=15) ::   clexp 
    329316      INTEGER, DIMENSION(jpidta,jpidta) ::   idata 
    330  
    331       REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk, zam20s 
    332  
    333       CHARACTER (len=15) ::   clexp 
    334       !!---------------------------------------------------------------------- 
    335  
    336       IF( iwrk_in_use(2, 1) )THEN 
    337          CALL ctl_stop('ldf_dyn_c2d_orca_R1: ERROR: requested workspace array is unavailable.') 
    338          RETURN 
    339       END IF 
     317      !!---------------------------------------------------------------------- 
     318 
     319      IF( iwrk_in_use(2, 1) ) THEN 
     320         CALL ctl_stop('ldf_dyn_c2d_orca_R1: requested workspace array is unavailable')   ;   RETURN 
     321      ENDIF 
    340322 
    341323      IF(lwp) WRITE(numout,*) 
    342324      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient' 
    343325      IF(lwp) WRITE(numout,*) '~~~~~~  --' 
    344       IF(lwp) WRITE(numout,*) 
    345       IF(lwp) WRITE(numout,*) '        orca_r1 ocean model' 
    346       IF(lwp) WRITE(numout,*) 
     326      IF(lwp) WRITE(numout,*) '        orca_r1 configuration' 
    347327 
    348328#if defined key_antarctic 
    … …  
    472452      ENDIF 
    473453 
    474       IF( iwrk_not_released(2, 1) )THEN 
    475          CALL ctl_stop('ldf_dyn_c2d_orca_R1: ERROR: failed to release workspace array.') 
    476       END IF 
    477  
     454      IF( iwrk_not_released(2, 1) )   CALL ctl_stop('ldf_dyn_c2d_orca_R1: failed to release workspace array') 
     455      ! 
    478456   END SUBROUTINE ldf_dyn_c2d_orca_R1 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90

    r2633 r2690  
    2626      !!       ??? explanation of the default is missing 
    2727      !!---------------------------------------------------------------------- 
    28       USE ldftra_oce, ONLY : aht0 
    29       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    30       USE wrk_nemo, ONLY: zcoef => wrk_1d_2 
    31       !! 
    32       LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    33       !! 
    34       INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    35       REAL(wp) ::   & 
    36          zr = 0.2 ,   &  ! maximum of the reduction factor at the bottom ocean 
    37          !               ! ( 0 < zr < 1 ) 
    38          zh = 500.,   &  ! depth of at which start the reduction ( > dept(1) ) 
    39          zd_max   ,   &  ! maximum grid spacing over the global domain 
    40          za00, zc, zd    ! temporary scalars 
    41       REAL(wp) ::        & 
    42          zetmax, zefmax, & 
    43          zeumax, zevmax    
    44       !!---------------------------------------------------------------------- 
    45  
    46       IF(wrk_in_use(1,2))THEN 
    47          CALL ctl_stop('ldf_dyn_c3d: ERROR: requested workspace array unavailable.') 
    48          RETURN 
    49       END IF 
     28      USE ldftra_oce, ONLY :   aht0 
     29      USE wrk_nemo  , ONLY:   wrk_in_use, wrk_not_released 
     30      USE wrk_nemo  , ONLY:   zcoef => wrk_1d_2 
     31      !! 
     32      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
     33      !! 
     34      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     35      REAL(wp) ::   zr = 0.2     ! maximum of the reduction factor at the bottom ocean ( 0 < zr < 1 ) 
     36      REAL(wp) ::   zh = 500.    ! depth of at which start the reduction ( > dept(1) ) 
     37      REAL(wp) ::   zd_max       ! maximum grid spacing over the global domain 
     38      REAL(wp) ::   za00, zc, zd, zetmax, zefmax, zeumax, zevmax   ! local scalars 
     39      !!---------------------------------------------------------------------- 
     40 
     41      IF( wrk_in_use(1,2) ) THEN 
     42         CALL ctl_stop('ldf_dyn_c3d: requested workspace array unavailable')   ;   RETURN 
     43      ENDIF 
    5044 
    5145      IF(lwp) WRITE(numout,*) 
    … …  
    187181         ENDIF 
    188182      ENDIF 
    189  
    190       IF(wrk_not_released(1,2))THEN 
    191          CALL ctl_stop('ldf_dyn_c3d: ERROR: failed to release workspace array.') 
    192       END IF 
    193  
     183      ! 
     184      IF( wrk_not_released(1,2) )   CALL ctl_stop('ldf_dyn_c3d: failed to release workspace array') 
     185      ! 
    194186   END SUBROUTINE ldf_dyn_c3d 
    195187 
    … …  
    203195      !! ** Method  :   blah blah blah .... 
    204196      !!---------------------------------------------------------------------- 
    205       USE ldftra_oce, ONLY : aht0 
    206       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
    207       USE wrk_nemo, ONLY:  icof => iwrk_2d_1 
    208       USE wrk_nemo, ONLY: zahm0 =>  wrk_2d_1 
    209       USE wrk_nemo, ONLY: zcoef =>  wrk_1d_1 
    210       !! 
    211       LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
     197      USE ldftra_oce, ONLY:  aht0 
     198      USE wrk_nemo  , ONLY:  wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
     199      USE wrk_nemo  , ONLY:   icof => iwrk_2d_1 
     200      USE wrk_nemo  , ONLY:  zahm0 =>  wrk_2d_1 
     201      USE wrk_nemo  , ONLY:  zcoef =>  wrk_1d_1 
     202      !! 
     203      LOGICAL, INTENT(in) ::  ld_print   ! If true, output arrays on numout 
    212204      !! 
    213205      INTEGER ::   ji, jj, jk, jn      ! dummy loop indices 
    214       INTEGER ::   ii0, ii1, ij0, ij1  ! temporary integers 
    215       INTEGER ::   inum                ! temporary logical unit 
    216       INTEGER ::   iim, ijm 
     206      INTEGER ::   ii0, ii1, ij0, ij1  ! local integers 
     207      INTEGER ::   inum, iim, ijm      !  
    217208      INTEGER ::   ifreq, il1, il2, ij, ii 
    218209      INTEGER, DIMENSION(jpidta, jpjdta) ::   idata 
    219210 
    220       REAL(wp) ::   & 
    221          zahmeq, zcoff, zcoft, zmsk,   & ! ??? 
    222          zemax, zemin, zeref, zahmm 
    223  
     211      REAL(wp) ::   zahmeq, zcoff, zcoft, zmsk   ! local scalars 
     212      REAL(wp) ::   zemax , zemin, zeref, zahmm 
    224213      CHARACTER (len=15) ::   clexp 
    225214      !!---------------------------------------------------------------------- 
    226215 
    227       IF( iwrk_in_use(2,1) .OR. wrk_in_use(2,1) .OR. wrk_in_use(1,1) )THEN 
    228          CALL ctl_stop('ldf_dyn_c3d_orca: ERROR: requested workspace arrays are unavailable.') 
    229          RETURN 
    230       END IF 
     216      IF( iwrk_in_use(2,1) .OR. wrk_in_use(2,1) .OR. wrk_in_use(1,1) ) THEN 
     217         CALL ctl_stop('ldf_dyn_c3d_orca: requested workspace arrays are unavailable')   ;   RETURN 
     218      ENDIF 
    231219 
    232220      IF(lwp) WRITE(numout,*) 
    233221      IF(lwp) WRITE(numout,*) 'ldfdyn_c3d_orca : 3D eddy viscosity coefficient' 
    234222      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    235       IF(lwp) WRITE(numout,*) 
    236       IF(lwp) WRITE(numout,*) '        orca R1, R2 or R4 ocean model' 
    237       IF(lwp) WRITE(numout,*) '  reduced in the surface Eq. strip ' 
    238       IF(lwp) WRITE(numout,*) 
     223      IF(lwp) WRITE(numout,*) '        orca R1, R2 or R4 configuration: reduced in the surface Eq. strip ' 
    239224 
    240225      ! Read 2d integer array to specify western boundary increase in the 
    … …  
    473458      ENDIF 
    474459 
    475       IF( iwrk_not_released(2,1) .OR. wrk_not_released(2,1) .OR. & 
    476            wrk_not_released(1,1) )THEN 
    477          CALL ctl_stop('ldf_dyn_c3d_orca: ERROR: failed to release workspace arrays.') 
    478       END IF 
    479  
     460      IF( iwrk_not_released(2,1) .OR.   & 
     461           wrk_not_released(2,1) .OR.   & 
     462           wrk_not_released(1,1)   ) CALL ctl_stop('ldf_dyn_c3d_orca: failed to release workspace arrays') 
     463      ! 
    480464   END SUBROUTINE ldf_dyn_c3d_orca 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90

    r2633 r2690  
    5353      !!             - wslpi, wslpj : i- and j-slopes of neutral surfaces at w-points.  
    5454      !!---------------------------------------------------------------------- 
    55       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    56       USE wrk_nemo, ONLY: zn  => wrk_2d_1, zah   => wrk_2d_2, & 
    57                           zhw => wrk_2d_3, zross => wrk_2d_4 
    58       !! 
     55      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     56      USE wrk_nemo, ONLY:   zn  => wrk_2d_1 , zah   => wrk_2d_2   ! 2D workspace 
     57      USE wrk_nemo, ONLY:   zhw => wrk_2d_3 , zross => wrk_2d_4 
     58      ! 
    5959      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    60       !! 
     60      ! 
    6161      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    6262      REAL(wp) ::   zfw, ze3w, zn2, zf20, zaht, zaht_min      ! temporary scalars 
    6363      !!---------------------------------------------------------------------- 
    6464       
    65       IF(wrk_in_use(2, 1,2,3,4))THEN 
    66          CALL ctl_stop('ldf_eiv: ERROR: requested workspace arrays are unavailable.') 
    67          RETURN 
    68       END IF 
     65      IF( wrk_in_use(2, 1,2,3,4) ) THEN 
     66         CALL ctl_stop('ldf_eiv: requested workspace arrays are unavailable.')   ;   RETURN 
     67      ENDIF 
    6968 
    7069      IF( kt == nit000 ) THEN 
    … …  
    244243      CALL iom_put( "aht2d_eiv", aeiw )   ! EIV lateral eddy diffusivity 
    245244      !   
    246       IF(wrk_not_released(2, 1,2,3,4))THEN 
    247          CALL ctl_stop('ldf_eiv: ERROR: failed to release workspace arrays.') 
    248       END IF 
     245      IF( wrk_not_released(2, 1,2,3,4) )   CALL ctl_stop('ldf_eiv: failed to release workspace arrays') 
    249246      ! 
    250247   END SUBROUTINE ldf_eiv 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r2678 r2690  
    115115      !!               of now neutral surfaces at u-, w- and v- w-points, resp. 
    116116      !!---------------------------------------------------------------------- 
    117       USE oce , zgru  => ua   ! use ua as workspace 
    118       USE oce , zgrv  => va   ! use va as workspace 
    119       USE oce , zww   => ta   ! use ta as workspace 
    120       USE oce , zwz   => sa   ! use sa as workspace 
    121117      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    122       USE wrk_nemo, ONLY: zdzr => wrk_3d_1 
     118      USE oce     , ONLY:   zgru => ua       , zww => va   ! (ua,va) used as workspace 
     119      USE oce     , ONLY:   zgrv => ta       , zwz => sa   ! (ta,sa) used as workspace 
     120      USE wrk_nemo, ONLY:   zdzr => wrk_3d_1               ! 3D workspace 
    123121      !! 
    124122      INTEGER , INTENT(in)                   ::   kt    ! ocean time-step index 
    … …  
    135133      !!---------------------------------------------------------------------- 
    136134 
    137       IF(wrk_in_use(3, 1) ) THEN 
     135      IF( wrk_in_use(3, 1) ) THEN 
    138136         CALL ctl_stop('ldf_slp: requested workspace arrays are unavailable')   ;   RETURN 
    139       END IF 
     137      ENDIF 
    140138 
    141139      zeps   =  1.e-20_wp        !==   Local constant initialization   ==! 
    … …  
    370368      ENDIF 
    371369 
    372        
    373370      ! IV. Lateral boundary conditions  
    374371      ! =============================== 
    … …  
    382379      ENDIF 
    383380      ! 
    384       IF(wrk_not_released(3, 1))THEN 
    385          CALL ctl_stop('ldf_slp: ERROR: failed to release workspace arrays.') 
    386       END IF 
     381      IF( wrk_not_released(3, 1) )   CALL ctl_stop('ldf_slp: failed to release workspace arrays') 
    387382      ! 
    388383   END SUBROUTINE ldf_slp 
    … …  
    403398      !!             - wslp2              squared slope of neutral surfaces at w-points. 
    404399      !!---------------------------------------------------------------------- 
    405       USE oce,   zdit  => ua   ! use ua as workspace 
    406       USE oce,   zdis  => va   ! use va as workspace 
    407       USE oce,   zdjt  => ta   ! use ta as workspace 
    408       USE oce,   zdjs  => sa   ! use sa as workspace 
    409       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    410       USE wrk_nemo, ONLY: zdkt   => wrk_3d_2, zdks  => wrk_3d_3, & 
    411                           zalpha => wrk_3d_4, zbeta => wrk_3d_5    ! alpha, beta at T points, at depth fsgdept 
    412       USE wrk_nemo, ONLY: z1_mlbw => wrk_2d_1 
    413       !! 
    414       INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
    415       !! 
     400      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     401      USE oce     , ONLY:   zdit    => ua       , zdis   => va         ! (ua,va) used as workspace 
     402      USE oce     , ONLY:   zdjt    => ta       , zdjs   => sa         ! (ta,sa) used as workspace 
     403      USE wrk_nemo, ONLY:   zdkt    => wrk_3d_2 , zdks   => wrk_3d_3   ! 3D workspace 
     404      USE wrk_nemo, ONLY:   zalpha  => wrk_3d_4 , zbeta => wrk_3d_5    ! alpha, beta at T points, at depth fsgdept 
     405      USE wrk_nemo, ONLY:   z1_mlbw => wrk_2d_1 
     406      ! 
     407      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     408      ! 
    416409      INTEGER  ::   ji, jj, jk, jl, ip, jp, kp  ! dummy loop indices 
    417       INTEGER  ::   iku, ikv                ! temporary integer 
     410      INTEGER  ::   iku, ikv                                  ! local integer 
    418411      REAL(wp) ::   zfacti, zfactj, zatempw,zatempu,zatempv   ! local scalars 
    419       REAL(wp) ::   zbu, zbv, zbti, zbtj 
     412      REAL(wp) ::   zbu, zbv, zbti, zbtj                      !   -      - 
    420413      REAL(wp) ::   zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_lim2, zti_g_raw, zti_g_lim 
    421414      REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_lim2, ztj_g_raw, ztj_g_lim 
    … …  
    423416      !!---------------------------------------------------------------------- 
    424417 
    425       IF( (wrk_in_use(3, 2,3,4,5)) .OR. (wrk_in_use(2, 1)) )THEN 
    426          CALL ctl_stop('ldf_slp_grif: ERROR: requested workspace arrays are unavailable.')   ;   RETURN 
    427       END IF 
     418      IF( wrk_in_use(3, 2,3,4,5) .OR. wrk_in_use(2, 1) )THEN 
     419         CALL ctl_stop('ldf_slp_grif: requested workspace arrays are unavailable')   ;   RETURN 
     420      ENDIF 
    428421 
    429422      !--------------------------------! 
    … …  
    607600      CALL lbc_lnk( wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked 
    608601      ! 
    609       IF(wrk_not_released(3, 2,3,4,5) .OR.   & 
    610          wrk_not_released(2, 1)        )   CALL ctl_stop('ldf_slp_grif: ERROR: failed to release workspace arrays.') 
     602      IF( wrk_not_released(3, 2,3,4,5) .OR.   & 
     603          wrk_not_released(2, 1)       )   CALL ctl_stop('ldf_slp_grif: failed to release workspace arrays') 
    611604      ! 
    612605   END SUBROUTINE ldf_slp_grif 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r2528 r2690  
    3636   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3737   !! $Id$ 
    38    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3939   !!---------------------------------------------------------------------- 
    40  
    4140CONTAINS 
    4241 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c1d.h90

    r2528 r2690  
    66   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    77   !! $Id$  
    8    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     8   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    99   !!---------------------------------------------------------------------- 
    1010 
    … …  
    2828      !!         always harmonic      : aeiu = aeiv defined at T-level 
    2929      !!            aeiw defined at w-level 
    30       !! 
    3130      !!---------------------------------------------------------------------- 
    32       !! * Arguments 
    33       LOGICAL, INTENT (in) :: ld_print   ! If true, print arrays in numout 
    34  
    35       !! * Local variables 
    36       INTEGER ::   jk                  ! dummy loop indices 
    37       REAL(wp) ::   & 
    38          zkah, zahr, za00 , za01,   &  ! temporary scalars 
    39          zahf, zahs, zahtf, zahts 
     31      LOGICAL, INTENT (in) ::   ld_print   ! If true, print arrays in numout 
     32      ! 
     33      INTEGER  ::   jk   ! dummy loop indices 
     34      REAL(wp) ::   zkah, zahr, za00 , za01    ! local scalars 
     35      REAL(wp) ::   zahf, zahs, zahtf, zahts   !   -      - 
    4036      !!---------------------------------------------------------------------- 
    4137 
    … …  
    130126      ENDIF 
    131127#endif 
    132  
     128      ! 
    133129   END SUBROUTINE ldf_tra_c1d 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c2d.h90

    r2528 r2690  
    2525      !!       eddy induced velocity 
    2626      !!           always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts 
    27       !! 
    2827      !!---------------------------------------------------------------------- 
    29       !! * Arguments 
    30       LOGICAL, INTENT (in) :: ld_print   ! If true, print arrays in numout 
    31  
    32       !! * Local variables 
    33       INTEGER ::   ji, jj                  ! dummy loop indices 
     28      LOGICAL, INTENT (in) ::   ld_print   ! If true, print arrays in numout 
     29      ! 
     30      INTEGER ::   ji, jj   ! dummy loop indices 
    3431# if defined key_orca_r4 
    3532      INTEGER :: i1, i2, j1, j2 
    3633# endif 
    3734      REAL(wp) ::   za00, zd_max, zeumax, zevmax, zetmax 
    38        
    3935      !!---------------------------------------------------------------------- 
    4036 
    … …  
    4339         IF(lwp) WRITE(numout,*) ' ldf_tra_c2d : 2D eddy diffusivity and eddy' 
    4440         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --  induced velocity coefficients' 
    45          IF(lwp) WRITE(numout,*) 
    4641      ELSE 
    4742         IF(lwp) WRITE(numout,*) 
    4843         IF(lwp) WRITE(numout,*) ' ldf_tra2d : 2D eddy diffusivity coefficient' 
    4944         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --' 
    50          IF(lwp) WRITE(numout,*) 
    5145      ENDIF 
    5246 
    … …  
    5751      ! ================== 
    5852      IF( ln_traldf_lap ) THEN 
    59    
     53         ! 
    6054         za00 = aht0 / zd_max 
    61    
     55         ! 
    6256         DO jj = 1, jpj  
    6357            DO ji = 1, jpi  
    … …  
    167161         CALL prihre(aeiw,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    168162      ENDIF 
    169  
    170163# endif 
    171  
     164      ! 
    172165   END SUBROUTINE ldf_tra_c2d 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90

    r2528 r2690  
    66   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    77   !! $Id$  
    8    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     8   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    99   !!---------------------------------------------------------------------- 
    1010 
    … …  
    2929      !!       eddy induced velocity 
    3030      !!         always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts 
    31       !! 
    3231      !!---------------------------------------------------------------------- 
    33       !! * Modules used 
    3432      USE ioipsl 
    35  
    36       !! * Arguments 
    37       LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    38  
     33      ! 
     34      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
    3935      !!---------------------------------------------------------------------- 
    4036 
    … …  
    4440         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --  ' 
    4541         IF(lwp) WRITE(numout,*) '               Coefficients set to constant' 
    46          IF(lwp) WRITE(numout,*) 
    4742      ELSE 
    4843         IF(lwp) WRITE(numout,*) 
    … …  
    5045         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   -- ' 
    5146         IF(lwp) WRITE(numout,*) '               Coefficients set to constant' 
    52          IF(lwp) WRITE(numout,*) 
    5347      ENDIF 
    5448 
    … …  
    127121         CALL prihre(aeiw(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    128122      ENDIF 
    129  
    130 END SUBROUTINE ldf_tra_c3d 
     123      ! 
     124   END SUBROUTINE ldf_tra_c3d 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90

    r2636 r2690  
    9191      ALLOCATE( ahtt(jpi,jpj,jpk) , ahtu(jpi,jpj,jpk) , ahtv(jpi,jpj,jpk) , ahtw(jpi,jpj,jpk) , STAT=ierr(1) ) 
    9292#elif defined key_traldf_c2d 
    93       ALLOCATE( ahtt(jpi,jpj     ), ahtu(jpi,jpj)    , ahtv(jpi,jpj    ) , ahtw(jpi,jpj    ) , STAT=ierr(1) ) 
     93      ALLOCATE( ahtt(jpi,jpj    ) , ahtu(jpi,jpj    ) , ahtv(jpi,jpj    ) , ahtw(jpi,jpj    ) , STAT=ierr(1) ) 
    9494#elif defined key_traldf_c1d 
    95       ALLOCATE( ahtt(         jpk) , ahtu(       jpk) , ahtv(        jpk) , ahtw(        jpk) , STAT=ierr(1) ) 
     95      ALLOCATE( ahtt(        jpk) , ahtu(        jpk) , ahtv(        jpk) , ahtw(        jpk) , STAT=ierr(1) ) 
    9696#endif 
    9797      ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90

    r2618 r2690  
    11MODULE obcdyn_bt 
     2   !!====================================================================== 
     3   !!                       ***  MODULE  obcdyn_bt  *** 
     4   !! Ocean dynamics:   Radiation/prescription of sea surface heights on each open boundary 
     5   !!====================================================================== 
     6   !! History :  1.0  ! 2005-12  (V. Garnier) original code 
     7   !!---------------------------------------------------------------------- 
    28#if ( defined key_dynspg_ts || defined key_dynspg_exp ) && defined key_obc 
    3    !!================================================================================= 
    4    !!                       ***  MODULE  obcdyn_bt  *** 
    5    !! Ocean dynamics:   Radiation/prescription of sea surface heights 
    6    !!                   on each open boundary 
    7    !!================================================================================= 
    8  
    9    !!--------------------------------------------------------------------------------- 
     9   !!---------------------------------------------------------------------- 
     10   !!   'key_dynspg_ts'     OR                   time spliting free surface 
     11   !!   'key_dynspg_exp'    AND                       explicit free surface 
     12   !!   'key_obc'                                   Open Boundary Condition 
     13   !!---------------------------------------------------------------------- 
    1014   !!   obc_dyn_bt        : call the subroutine for each open boundary 
    1115   !!   obc_dyn_bt_east   : Flather's algorithm at the east open boundary 
    … …  
    1317   !!   obc_dyn_bt_north  : Flather's algorithm at the north open boundary 
    1418   !!   obc_dyn_bt_south  : Flather's algorithm at the south open boundary 
    15    !!---------------------------------------------------------------------------------- 
    16  
    17    !!---------------------------------------------------------------------------------- 
     19   !!---------------------------------------------------------------------- 
    1820   USE oce             ! ocean dynamics and tracers  
    1921   USE dom_oce         ! ocean space and time domain 
    … …  
    2931   PRIVATE 
    3032 
    31    !! * Accessibility 
    32    PUBLIC obc_dyn_bt  ! routine called in dynnxt (explicit free surface case) 
    33  
    34    !!--------------------------------------------------------------------------------- 
     33   PUBLIC   obc_dyn_bt  ! routine called in dynnxt (explicit free surface case) 
     34 
     35   !!---------------------------------------------------------------------- 
    3536   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3637   !! $Id$  
    37    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    38    !!---------------------------------------------------------------------- 
    39  
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     39   !!---------------------------------------------------------------------- 
    4040CONTAINS 
    4141 
    4242   SUBROUTINE obc_dyn_bt( kt ) 
    43       !!------------------------------------------------------------------------------ 
    44       !!                      SUBROUTINE obc_dyn_bt 
    45       !!                     *********************** 
    46       !! ** Purpose : 
    47       !!      Apply Flather's algorithm at open boundaries for the explicit 
    48       !!      free surface case and free surface case with time-splitting 
     43      !!---------------------------------------------------------------------- 
     44      !!                 ***  SUBROUTINE obc_dyn_bt  *** 
     45      !! 
     46      !! ** Purpose :   Apply Flather's algorithm at open boundaries for the explicit 
     47      !!              free surface case and free surface case with time-splitting 
    4948      !! 
    5049      !!      This routine is called in dynnxt.F routine and updates ua, va and sshn.  
    … …  
    5453      !!      open one (must be done in the param_obc.h90 file). 
    5554      !! 
    56       !! ** Reference :   Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164 
    57       !! 
    58       !! History :  9.0  !  05-12  (V. Garnier) original  
    59       !!---------------------------------------------------------------------- 
    60       !! * Arguments 
    61       INTEGER, INTENT( in ) ::   kt 
    62  
     55      !! Reference :   Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164 
     56      !!---------------------------------------------------------------------- 
     57      INTEGER, INTENT(in) ::   kt 
    6358      !!---------------------------------------------------------------------- 
    6459 
    … …  
    8277 
    8378# if defined key_dynspg_exp 
     79 
    8480   SUBROUTINE obc_dyn_bt_east  
    85       !!------------------------------------------------------------------------------ 
     81      !!---------------------------------------------------------------------- 
    8682      !!                  ***  SUBROUTINE obc_dyn_bt_east  *** 
    8783      !!               
    … …  
    9086      !!      Fix sea surface height (sshn) on east open boundary 
    9187      !!      The logical lfbceast must be .TRUE. 
    92       !! 
    93       !!  History : 
    94       !!   9.0  !  05-12  (V. Garnier) original 
    95       !!------------------------------------------------------------------------------ 
    96       !! * Local declaration 
    97       INTEGER ::   ji, jj, jk ! dummy loop indices 
    98       !!------------------------------------------------------------------------------ 
     88      !!---------------------------------------------------------------------- 
     89      INTEGER, INTENT(in) ::   kt 
     90      !!---------------------------------------------------------------------- 
     91      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     92      !!---------------------------------------------------------------------- 
    9993 
    10094      DO ji = nie0, nie1 
    … …  
    117111 
    118112   SUBROUTINE obc_dyn_bt_west  
    119       !!------------------------------------------------------------------------------ 
     113      !!---------------------------------------------------------------------- 
    120114      !!                  ***  SUBROUTINE obc_dyn_bt_west  *** 
    121115      !!                   
    … …  
    124118      !!      Fix sea surface height (sshn) on west open boundary 
    125119      !!      The logical lfbcwest must be .TRUE. 
    126       !! 
    127       !!  History : 
    128       !!   9.0  !  05-12  (V. Garnier) original 
    129       !!------------------------------------------------------------------------------ 
    130       !! * Local declaration 
    131       INTEGER ::   ji, jj, jk ! dummy loop indices 
    132       !!------------------------------------------------------------------------------ 
    133  
     120      !!---------------------------------------------------------------------- 
     121      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     122      !!---------------------------------------------------------------------- 
     123      ! 
    134124      DO ji = niw0, niw1 
    135125         DO jk = 1, jpkm1 
    … …  
    144134         END DO 
    145135      END DO 
    146  
     136      ! 
    147137   END SUBROUTINE obc_dyn_bt_west 
     138 
    148139 
    149140   SUBROUTINE obc_dyn_bt_north  
    … …  
    155146      !!      Fix sea surface height (sshn) on north open boundary 
    156147      !!      The logical lfbcnorth must be .TRUE. 
    157       !! 
    158       !!  History : 
    159       !!   9.0  !  05-12  (V. Garnier) original 
    160       !!------------------------------------------------------------------------------ 
    161       !! * Local declaration 
    162       INTEGER ::   ji, jj, jk ! dummy loop indices 
    163       !!------------------------------------------------------------------------------ 
    164  
     148      !!---------------------------------------------------------------------- 
     149      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     150      !!---------------------------------------------------------------------- 
     151      ! 
    165152      DO jj = njn0, njn1 
    166153         DO jk = 1, jpkm1 
    … …  
    177164         END DO 
    178165      END DO 
    179  
     166      ! 
    180167   END SUBROUTINE obc_dyn_bt_north 
    181168 
     169 
    182170   SUBROUTINE obc_dyn_bt_south  
    183       !!------------------------------------------------------------------------------ 
     171      !!---------------------------------------------------------------------- 
    184172      !!                ***  SUBROUTINE obc_dyn_bt_south  *** 
    185173      !!                     
    … …  
    188176      !!      Fix sea surface height (sshn) on south open boundary 
    189177      !!      The logical lfbcsouth must be .TRUE. 
    190       !! 
    191       !!  History : 
    192       !!   9.0  !  05-12  (V. Garnier) original 
    193       !!------------------------------------------------------------------------------ 
    194       !! * Local declaration 
    195       INTEGER ::   ji, jj, jk ! dummy loop indices 
    196  
    197       !!------------------------------------------------------------------------------ 
    198  
     178      !!---------------------------------------------------------------------- 
     179      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     180      !!---------------------------------------------------------------------- 
     181      ! 
    199182      DO jj = njs0, njs1 
    200183         DO jk = 1, jpkm1 
    … …  
    209192         END DO 
    210193      END DO 
    211  
     194      ! 
    212195   END SUBROUTINE obc_dyn_bt_south 
    213196 
    … …  
    222205      !!      Fix sea surface height (sshn) on east open boundary 
    223206      !!      The logical lfbceast must be .TRUE. 
    224       !! 
    225       !!  History : 
    226       !!   9.0  !  05-12  (V. Garnier) original 
    227       !!------------------------------------------------------------------------------ 
    228       !! * Local declaration 
    229       INTEGER ::   ji, jj, jk ! dummy loop indices 
    230       !!------------------------------------------------------------------------------ 
    231  
     207      !!---------------------------------------------------------------------- 
     208      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     209      !!---------------------------------------------------------------------- 
     210      ! 
    232211      DO ji = nie0, nie1 
    233212         DO jk = 1, jpkm1 
    … …  
    242221         END DO 
    243222      END DO 
    244  
     223      ! 
    245224   END SUBROUTINE obc_dyn_bt_east 
    246225 
     226 
    247227   SUBROUTINE obc_dyn_bt_west  
    248       !!------------------------------------------------------------------------------ 
     228      !!--------------------------------------------------------------------- 
    249229      !!                  ***  SUBROUTINE obc_dyn_bt_west  *** 
    250230      !! 
    251       !! ** Purpose : 
    252       !! ** Purpose : 
    253       !!      Apply Flather algorithm on west OBC velocities ua, va 
     231      !! ** Purpose :   Apply Flather algorithm on west OBC velocities ua, va 
    254232      !!      Fix sea surface height (sshn) on west open boundary 
    255233      !!      The logical lfbcwest must be .TRUE. 
    256       !! 
    257       !!  History : 
    258       !!   9.0  !  05-12  (V. Garnier) original 
    259       !!------------------------------------------------------------------------------ 
    260       !! * Local declaration 
    261       INTEGER ::   ji, jj, jk ! dummy loop indices 
    262       !!------------------------------------------------------------------------------ 
    263  
     234      !!---------------------------------------------------------------------- 
     235      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     236      !!---------------------------------------------------------------------- 
     237      ! 
    264238      DO ji = niw0, niw1 
    265239         DO jk = 1, jpkm1 
    … …  
    272246         END DO 
    273247      END DO 
    274  
     248      ! 
    275249   END SUBROUTINE obc_dyn_bt_west 
     250 
    276251 
    277252   SUBROUTINE obc_dyn_bt_north  
    278253      !!------------------------------------------------------------------------------ 
    279       !!                     SUBROUTINE obc_dyn_bt_north 
    280       !!                    ************************* 
     254      !!                ***  SUBROUTINE obc_dyn_bt_north  *** 
     255      !!                 
    281256      !! ** Purpose : 
    282257      !!      Apply Flather algorithm on north OBC velocities ua, va 
    283258      !!      Fix sea surface height (sshn) on north open boundary 
    284259      !!      The logical lfbcnorth must be .TRUE. 
    285       !! 
    286       !!  History : 
    287       !!   9.0  !  05-12  (V. Garnier) original 
    288       !!------------------------------------------------------------------------------ 
    289       !! * Local declaration 
    290       INTEGER ::   ji, jj, jk ! dummy loop indices 
    291       !!------------------------------------------------------------------------------ 
    292  
     260      !!---------------------------------------------------------------------- 
     261      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     262      !!---------------------------------------------------------------------- 
     263      ! 
    293264      DO jj = njn0, njn1 
    294265         DO jk = 1, jpkm1 
    … …  
    303274         END DO 
    304275      END DO 
    305  
     276      ! 
    306277   END SUBROUTINE obc_dyn_bt_north 
     278 
    307279 
    308280   SUBROUTINE obc_dyn_bt_south  
    309281      !!------------------------------------------------------------------------------ 
    310       !!                     SUBROUTINE obc_dyn_bt_south 
    311       !!                    ************************* 
     282      !!                ***  SUBROUTINE obc_dyn_bt_south  *** 
     283      !!                   
    312284      !! ** Purpose : 
    313285      !!      Apply Flather algorithm on south OBC velocities ua, va 
    314286      !!      Fix sea surface height (sshn) on south open boundary 
    315287      !!      The logical lfbcsouth must be .TRUE. 
    316       !! 
    317       !!  History : 
    318       !!   9.0  !  05-12  (V. Garnier) original 
    319       !!------------------------------------------------------------------------------ 
    320       INTEGER ::   ji, jj, jk ! dummy loop indices 
    321       !!------------------------------------------------------------------------------ 
    322  
     288      !!---------------------------------------------------------------------- 
     289      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     290      !!---------------------------------------------------------------------- 
     291      ! 
    323292      DO jj = njs0, njs1 
    324293         DO jk = 1, jpkm1 
    … …  
    331300         END DO 
    332301      END DO 
    333  
     302      ! 
    334303   END SUBROUTINE obc_dyn_bt_south 
    335304 
    336305# endif 
     306 
    337307#else 
    338    !!================================================================================= 
    339    !!                       ***  MODULE  obcdyn_bt  *** 
    340    !! Ocean dynamics:   Radiation of velocities on each open boundary 
    341    !!================================================================================= 
     308   !!---------------------------------------------------------------------- 
     309   !!   Default option       No Open Boundaries or not explicit fre surface 
     310   !!---------------------------------------------------------------------- 
    342311CONTAINS 
    343  
    344    SUBROUTINE obc_dyn_bt 
    345                               ! No open boundaries ==> empty routine 
     312   SUBROUTINE obc_dyn_bt      ! Dummy routine 
    346313   END SUBROUTINE obc_dyn_bt 
    347314#endif 
    348315 
     316   !!====================================================================== 
    349317END MODULE obcdyn_bt 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC/obcfla.F90

    r2618 r2690  
    88   !!            4.0  ! 2011-02  (G. Madec) velocity & ssh passed in argument 
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_obc && defined key_dynspg_ts 
     10#if defined key_obc   &&  defined key_dynspg_ts 
    1111   !!---------------------------------------------------------------------- 
    1212   !!   'key_obc'          and                      Open Boundary Condition 
    … …  
    7575      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height 
    7676      ! 
    77       INTEGER ::   ji, jj ! dummy loop indices 
     77      INTEGER ::   ji, jj   ! dummy loop indices 
    7878      !!---------------------------------------------------------------------- 
    7979      ! 
    … …  
    106106      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height 
    107107      ! 
    108       INTEGER ::   ji, jj ! dummy loop indices 
     108      INTEGER ::   ji, jj   ! dummy loop indices 
    109109      !!---------------------------------------------------------------------- 
    110110      ! 
    … …  
    133133      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height 
    134134      ! 
    135       INTEGER ::   ji, jj ! dummy loop indices 
     135      INTEGER ::   ji, jj   ! dummy loop indices 
    136136      !!---------------------------------------------------------------------- 
    137137      ! 
    … …  
    164164      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height 
    165165      ! 
    166       INTEGER ::   ji, jj ! dummy loop indices 
     166      INTEGER ::   ji, jj   ! dummy loop indices 
    167167      !!---------------------------------------------------------------------- 
    168168      ! 
    … …  
    185185   !!---------------------------------------------------------------------- 
    186186CONTAINS 
    187  
    188187   SUBROUTINE obc_fla_ts( pua, pva, p_sshn, p_ssha ) 
    189188      REAL, DIMENSION(:,:)::   pua, pva, p_sshn, p_ssha 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r2640 r2690  
    6666      !!---------------------------------------------------------------------- 
    6767      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    68       USE wrk_nemo, ONLY:   wrk_3d_6, wrk_3d_7    ! 3D workspace 
     68      USE wrk_nemo, ONLY:   wrk_3d_6 , wrk_3d_7    ! 3D workspace 
    6969      !! 
    7070      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pt_ice      !  ice surface temperature (Kelvin) 
    … …  
    187187      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_cs   !  albedo of ocean under clear sky 
    188188      !! 
    189       REAL(wp) ::   zcoef   ! temporary scalar 
     189      REAL(wp) ::   zcoef   ! local scalar 
    190190      !!---------------------------------------------------------------------- 
    191191      ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r2620 r2690  
    3232   USE dom_oce                      ! ocean space and time domain 
    3333   USE in_out_manager               ! I/O manager 
    34    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     34   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link) 
    3535 
    3636   IMPLICIT NONE 
    3737   PRIVATE 
    3838 
    39    PUBLIC cpl_prism_init 
    40    PUBLIC cpl_prism_define 
    41    PUBLIC cpl_prism_snd 
    42    PUBLIC cpl_prism_rcv 
    43    PUBLIC cpl_prism_freq 
    44    PUBLIC cpl_prism_finalize 
    45  
    46    LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.   !: coupled flag 
    47    INTEGER, PUBLIC            :: OASIS_Rcv  = 1    !: return code if received field 
    48    INTEGER, PUBLIC            :: OASIS_idle = 0    !: return code if nothing done by oasis 
    49    INTEGER                    :: ncomp_id          ! id returned by prism_init_comp 
    50    INTEGER                    :: nerror            ! return error code 
    51  
    52    INTEGER, PARAMETER :: nmaxfld=40    ! Maximum number of coupling fields 
     39   PUBLIC   cpl_prism_init 
     40   PUBLIC   cpl_prism_define 
     41   PUBLIC   cpl_prism_snd 
     42   PUBLIC   cpl_prism_rcv 
     43   PUBLIC   cpl_prism_freq 
     44   PUBLIC   cpl_prism_finalize 
     45 
     46   LOGICAL, PUBLIC, PARAMETER ::   lk_cpl = .TRUE.   !: coupled flag 
     47   INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field 
     48   INTEGER, PUBLIC            ::   OASIS_idle = 0    !: return code if nothing done by oasis 
     49   INTEGER                    ::   ncomp_id          ! id returned by prism_init_comp 
     50   INTEGER                    ::   nerror            ! return error code 
     51 
     52   INTEGER, PARAMETER ::   nmaxfld=40    ! Maximum number of coupling fields 
    5353    
    5454   TYPE, PUBLIC ::   FLD_CPL            !: Type for coupling field information 
    … …  
    6060   END TYPE FLD_CPL 
    6161 
    62    TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd   !: Coupling fields 
    63  
    64    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld  ! Temporary buffer for receiving 
     62   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC ::   srcv, ssnd   !: Coupling fields 
     63 
     64   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   exfld   ! Temporary buffer for receiving 
    6565 
    6666   !!---------------------------------------------------------------------- 
    … …  
    243243      INTEGER                 , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
    244244      !! 
    245       LOGICAL                :: llaction 
     245      LOGICAL ::  llaction 
    246246      !!-------------------------------------------------------------------- 
    247247      ! 
    … …  
    284284 
    285285 
    286    FUNCTION cpl_prism_freq( kid )   
     286   INTEGER FUNCTION cpl_prism_freq( kid )   
    287287      !!--------------------------------------------------------------------- 
    288288      !!              ***  ROUTINE cpl_prism_freq  *** 
    … …  
    290290      !! ** Purpose : - send back the coupling frequency for a particular field 
    291291      !!---------------------------------------------------------------------- 
    292       INTEGER,INTENT( IN )   :: kid              ! variable index  
    293       INTEGER                :: cpl_prism_freq   ! coupling frequency 
     292      INTEGER,INTENT(in) ::   kid   ! variable index  
    294293      !!---------------------------------------------------------------------- 
    295294      cpl_prism_freq = ig_def_freq( kid ) 
    … …  
    307306      !!---------------------------------------------------------------------- 
    308307      ! 
    309       DEALLOCATE(exfld) 
    310       CALL prism_terminate_proto ( nerror )          
     308      DEALLOCATE( exfld ) 
     309      CALL prism_terminate_proto( nerror )          
    311310      ! 
    312311   END SUBROUTINE cpl_prism_finalize 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r2636 r2690  
    822822      ! 
    823823      IF(  wrk_in_use(2, 1)  .OR.  iwrk_in_use(2,1) ) THEN 
    824          CALL ctl_stop('fld_weights: requested workspace arrays are unavailable.')   ;   RETURN 
     824         CALL ctl_stop('fld_weights: requested workspace arrays are unavailable')   ;   RETURN 
    825825      ENDIF 
    826826      ! 
    … …  
    936936 
    937937      IF(  wrk_not_released(2, 1) .OR.    & 
    938           iwrk_not_released(2, 1)   )   CALL ctl_stop('fld_weights: failed to release workspace arrays') 
     938          iwrk_not_released(2, 1)  )   CALL ctl_stop('fld_weights: failed to release workspace arrays') 
    939939      ! 
    940940   END SUBROUTINE fld_weight 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90

    r2636 r2690  
    513513      !!   8.5  !  02-08  (G. Madec)  F90: Free form 
    514514      !!---------------------------------------------------------------------- 
    515       !! * Arguments 
    516       REAL(wp), INTENT( IN   ), DIMENSION(jpi,jpj) ::   & 
    517          px1, py1          ! two horizontal components to be rotated 
    518       REAL(wp), INTENT( OUT  ), DIMENSION(jpi,jpj) ::   & 
    519          px2, py2          ! the two horizontal components in the model repere 
    520       INTEGER, INTENT( IN ) ::   & 
    521          kchoix   ! type of transformation 
    522                   ! = 1 change from geographic to model grid. 
    523                   ! =-1 change from model to geographic grid 
    524       CHARACTER(len=1), INTENT( IN ), OPTIONAL ::   cd_type      ! define the nature of pt2d array grid-points 
     515      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   px1, py1   ! two horizontal components to be rotated 
     516      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   px2, py2   ! the two horizontal components in the model repere 
     517      INTEGER , INTENT(in   )                     ::   kchoix     ! type of transformation 
     518      !                                                           ! = 1 change from geographic to model grid. 
     519      !                                                           ! =-1 change from model to geographic grid 
     520      CHARACTER(len=1), INTENT(in   ), OPTIONAL   ::   cd_type    ! define the nature of pt2d array grid-points 
    525521      ! 
    526522      CHARACTER(len=1) ::   cl_type      ! define the nature of pt2d array grid-points (T point by default) 
    … …  
    554550      !!   9.2  !  09-02  (K. Mogensen) 
    555551      !!---------------------------------------------------------------------- 
    556       REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT )::   & 
    557          & psinu, pcosu, psinv, pcosv! copy of data 
     552      REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT )::   psinu, pcosu, psinv, pcosv   ! copy of data 
    558553      !!---------------------------------------------------------------------- 
    559554 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r2620 r2690  
    7777         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     ,     & 
    7878         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     & 
    79          &      emp_ice(jpi,jpj)                              , STAT=sbc_ice_alloc ) 
     79         &      emp_ice(jpi,jpj)                              , STAT= sbc_ice_alloc ) 
    8080         ! 
    8181      IF( lk_mpp            )   CALL mpp_sum ( sbc_ice_alloc ) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r2620 r2690  
    103103         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , STAT=ierr(1) )  
    104104         ! 
    105       ALLOCATE( qns_tot(jpi,jpj) , qns   (jpi,jpj) , qns_b(jpi,jpj),      & 
    106          &      qsr_tot(jpi,jpj) , qsr   (jpi,jpj) ,                     & 
    107          &      emp    (jpi,jpj) , emp_b (jpi,jpj) ,                       & 
    108          &      emps   (jpi,jpj) , emps_b(jpi,jpj) , emp_tot(jpi,jpj) , STAT=ierr(2)) 
     105      ALLOCATE( qns_tot(jpi,jpj) , qns   (jpi,jpj) , qns_b(jpi,jpj),        & 
     106         &      qsr_tot(jpi,jpj) , qsr   (jpi,jpj) ,                        & 
     107         &      emp    (jpi,jpj) , emp_b (jpi,jpj) ,                        & 
     108         &      emps   (jpi,jpj) , emps_b(jpi,jpj) , emp_tot(jpi,jpj) , STAT=ierr(2) ) 
    109109         ! 
    110110      ALLOCATE( rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     & 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90

    r2620 r2690  
    2727   PUBLIC   sbc_gyre   ! routine called in sbcmod module 
    2828 
    29    !                               !!* Namelist namsbc_ana * 
    30    INTEGER  ::   nn_tau000 = 1      ! nb of time-step during which the surface stress 
    31    !                                ! increase from 0 to its nominal value  
    32    REAL(wp) ::   rn_utau0  = 0.e0   ! constant wind stress value in i-direction 
    33    REAL(wp) ::   rn_vtau0  = 0.e0   ! constant wind stress value in j-direction 
    34    REAL(wp) ::   rn_qns0   = 0.e0   ! non solar heat flux 
    35    REAL(wp) ::   rn_qsr0   = 0.e0   !     solar heat flux 
    36    REAL(wp) ::   rn_emp0   = 0.e0   ! net freshwater flux 
     29   !                                !!* Namelist namsbc_ana * 
     30   INTEGER  ::   nn_tau000 = 1       ! nb of time-step during which the surface stress 
     31   !                                 ! increase from 0 to its nominal value  
     32   REAL(wp) ::   rn_utau0  = 0._wp   ! constant wind stress value in i-direction 
     33   REAL(wp) ::   rn_vtau0  = 0._wp   ! constant wind stress value in j-direction 
     34   REAL(wp) ::   rn_qns0   = 0._wp   ! non solar heat flux 
     35   REAL(wp) ::   rn_qsr0   = 0._wp   !     solar heat flux 
     36   REAL(wp) ::   rn_emp0   = 0._wp   ! net freshwater flux 
    3737    
    3838   !! * Substitutions 
    … …  
    6363      !!---------------------------------------------------------------------- 
    6464      INTEGER, INTENT(in) ::   kt       ! ocean time step 
    65       !! 
    66       REAL(wp)            ::   zfacto                ! local scalar 
    67       REAL(wp)            ::   zrhoa  = 1.22         ! Air density kg/m3 
    68       REAL(wp)            ::   zcdrag = 1.5e-3       ! drag coefficient 
    69       REAL(wp)            ::   ztx, zty, zmod, zcoef ! temporary variables 
     65      ! 
     66      REAL(wp) ::   zfacto                ! local scalar 
     67      REAL(wp) ::   zrhoa  = 1.22_wp      ! Air density kg/m3 
     68      REAL(wp) ::   zcdrag = 1.5e-3_wp    ! drag coefficient 
     69      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables 
    7070      !! 
    7171      NAMELIST/namsbc_ana/ nn_tau000, rn_utau0, rn_vtau0, rn_qns0, rn_qsr0, rn_emp0 
    … …  
    7474      IF( kt == nit000 ) THEN 
    7575         ! 
    76          REWIND ( numnam )                   ! Read Namelist namsbc : surface fluxes 
    77          READ   ( numnam, namsbc_ana ) 
     76         REWIND( numnam )                    ! Read Namelist namsbc : surface fluxes 
     77         READ  ( numnam, namsbc_ana ) 
    7878         ! 
    7979         IF(lwp) WRITE(numout,*)' ' 
    … …  
    8787         IF(lwp) WRITE(numout,*)'              net heat flux          rn_emp0   = ', rn_emp0  , ' Kg/m2/s' 
    8888         ! 
    89          nn_tau000 = MAX( nn_tau000, 1 )   ! must be >= 1 
     89         nn_tau000 = MAX( nn_tau000, 1 )     ! must be >= 1 
    9090         ! 
    9191      ENDIF 
    … …  
    304304         WRITE(numout,*)'           ndastp     = ', ndastp 
    305305         WRITE(numout,*)'           adatrj     = ', adatrj 
    306  
    307306      ENDIF 
    308307      ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r2674 r2690  
    5252   INTEGER , PARAMETER ::   jp_tair = 6           ! index of 10m air temperature             (Kelvin) 
    5353   INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s) 
     54 
    5455   TYPE(FLD),ALLOCATABLE,DIMENSION(:) :: sf  ! structure of input fields (file informations, fields read) 
    5556 
    … …  
    115116      !!              - emp, emps   evaporation minus precipitation 
    116117      !!---------------------------------------------------------------------- 
    117       INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    118       !! 
    119       INTEGER  ::   ifpr, jfpr         ! dummy indices 
     118      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     119      !! 
     120      INTEGER  ::   ifpr, jfpr   ! dummy indices 
    120121      INTEGER  ::   ierr0, ierr1, ierr2, ierr3   ! return error code 
    121122      !! 
    … …  
    236237      ENDIF 
    237238 
    238       zpatm = 101000.      ! atmospheric pressure  (assumed constant here) 
     239      zpatm = 101000._wp      ! atmospheric pressure  (assumed constant here) 
    239240 
    240241      !------------------------------------! 
    … …  
    634635 
    635636      IF( wrk_not_released(2, 1,2,3,4)  .OR.   & 
    636           wrk_not_released(3, 1,2)        )    & 
    637          CALL ctl_stop('blk_ice_clio: failed to release workspace arrays.') 
     637          wrk_not_released(3, 1,2)      )   CALL ctl_stop('blk_ice_clio: failed to release workspace arrays') 
    638638      ! 
    639639   END SUBROUTINE blk_ice_clio 
    … …  
    653653      USE wrk_nemo, ONLY:   zev   => wrk_2d_1                  ! vapour pressure 
    654654      USE wrk_nemo, ONLY:   zdlha => wrk_2d_2 , zlsrise => wrk_2d_3 , zlsset => wrk_2d_4  
    655       USE wrk_nemo, ONLY:   zps   => wrk_2d_5 , zpc     => wrk_2d_6 ! sin/cos of latitude per sin/cos of solar declination  
     655      USE wrk_nemo, ONLY:   zps   => wrk_2d_5 , zpc     => wrk_2d_6   ! sin/cos of latitude per sin/cos of solar declination  
    656656      !! 
    657657      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)     ::   pqsr_oce    ! shortwave radiation  over the ocean 
    … …  
    811811      USE wrk_nemo, ONLY:   zlsrise => wrk_2d_3     ! 2D workspace 
    812812      USE wrk_nemo, ONLY:   zlsset  => wrk_2d_4     ! 2D workspace 
    813       USE wrk_nemo, ONLY:   zps     => wrk_2d_5, zpc => wrk_2d_6   ! sin/cos of latitude per sin/cos of solar declination  
     813      USE wrk_nemo, ONLY:   zps     => wrk_2d_5 , zpc => wrk_2d_6   ! sin/cos of latitude per sin/cos of solar declination  
    814814      !! 
    815815      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pa_ice_cs   ! albedo of ice under clear sky 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r2636 r2690  
    5454   INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s) 
    5555   INTEGER , PARAMETER ::   jp_tdif = 9           ! index of tau diff associated to HF tau   (N/m2)   at T-point 
     56    
    5657   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read) 
    5758          
    … …  
    111112      !!              - emp, emps   evaporation minus precipitation 
    112113      !!---------------------------------------------------------------------- 
    113       INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
     114      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    114115      !! 
    115116      INTEGER  ::   ierror   ! return error code 
    … …  
    231232 
    232233      IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13) ) THEN 
    233          CALL ctl_stop('blk_oce_core: requested workspace arrays unavailable.')   ;   RETURN 
     234         CALL ctl_stop('blk_oce_core: requested workspace arrays unavailable')   ;   RETURN 
    234235      ENDIF 
    235236      ! 
    … …  
    605606      ENDIF 
    606607 
    607       IF( wrk_not_released(2, 1) .OR.   & 
     608      IF( wrk_not_released(2, 1)       .OR.   & 
    608609          wrk_not_released(3, 4,5,6,7) )   CALL ctl_stop('blk_ice_core: failed to release workspace arrays') 
    609610      ! 
    … …  
    663664      !!---------------------------------------------------------------------- 
    664665 
    665       IF( wrk_in_use(2,             14,15,16,17,18,19,      & 
    666                         20,21,22,23,24,25,26,27,28,29,      & 
    667                         30,31,32)                      .OR. & 
    668           iwrk_in_use(2, 1)                              ) THEN 
     666      IF(  wrk_in_use(2,             14,15,16,17,18,19,        & 
     667                         20,21,22,23,24,25,26,27,28,29,        & 
     668                         30,31,32)                      .OR.  & 
     669          iwrk_in_use(2, 1)                               ) THEN 
    669670         CALL ctl_stop('TURB_CORE_1Z: requested workspace arrays unavailable')   ;   RETURN 
    670671      ENDIF 
    … …  
    797798      !!  * Start 
    798799 
    799       IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21) .OR. & 
    800           iwrk_in_use(2, 1) )THEN 
    801          CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable.') 
    802          RETURN 
     800      IF(  wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21) .OR. & 
     801          iwrk_in_use(2, 1) ) THEN 
     802         CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable')   ;   RETURN 
    803803      END IF 
    804804 
    … …  
    876876      END DO 
    877877      !! 
    878       IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21) .OR. & 
    879           iwrk_not_released(2, 1) )THEN 
    880          CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable.') 
    881       END IF 
     878      IF(  wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21) .OR.   & 
     879          iwrk_not_released(2, 1)    )   CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable') 
    882880      ! 
    883881    END SUBROUTINE TURB_CORE_2Z 
    … …  
    897895      !------------------------------------------------------------------------------- 
    898896 
    899       IF(wrk_in_use(2, 33,34,35))THEN 
    900          CALL ctl_stop('psi_m: requested workspace arrays unavailable.') 
    901          RETURN 
    902       END IF 
     897      IF( wrk_in_use(2, 33,34,35) ) THEN 
     898         CALL ctl_stop('psi_m: requested workspace arrays unavailable')   ;   RETURN 
     899      ENDIF 
    903900 
    904901      X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.0) ;  X  = sqrt(X2) 
    905902      stabit    = 0.5 + sign(0.5,zta) 
    906       psi_m = -5.*zta*stabit  &                                                  ! Stable 
    907            & + (1. - stabit)*(2*log((1. + X)/2) + log((1. + X2)/2) - 2*atan(X) + pi/2)  ! Unstable  
    908  
    909       IF( wrk_not_released(2, 33,34,35) ) THEN 
    910          CALL ctl_stop('psi_m: failed to release workspace arrays.') 
    911          RETURN 
    912       END IF 
    913  
     903      psi_m = -5.*zta*stabit  &                                                          ! Stable 
     904         &    + (1. - stabit)*(2*log((1. + X)/2) + log((1. + X2)/2) - 2*atan(X) + pi/2)  ! Unstable  
     905 
     906      IF( wrk_not_released(2, 33,34,35) )   CALL ctl_stop('psi_m: failed to release workspace arrays') 
     907      ! 
    914908    END FUNCTION psi_m 
    915909 
    916910 
    917     FUNCTION psi_h(zta)    !! Psis, L & Y eq. (8c), (8d), (8e) 
     911    FUNCTION psi_h( zta )    !! Psis, L & Y eq. (8c), (8d), (8e) 
    918912      !------------------------------------------------------------------------------- 
    919913      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    … …  
    921915      USE wrk_nemo, ONLY:     X  => wrk_2d_34 
    922916      USE wrk_nemo, ONLY: stabit => wrk_2d_35 
    923       !! 
    924       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: zta 
    925  
    926       REAL(wp), DIMENSION(jpi,jpj)             :: psi_h 
     917      ! 
     918      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   zta 
     919      ! 
     920      REAL(wp), DIMENSION(jpi,jpj)             ::   psi_h 
    927921      !------------------------------------------------------------------------------- 
    928922 
    … …  
    934928      stabit    = 0.5 + sign(0.5,zta) 
    935929      psi_h = -5.*zta*stabit  &                                       ! Stable 
    936            & + (1. - stabit)*(2.*log( (1. + X2)/2. ))                 ! Unstable 
    937  
    938       IF( wrk_not_released(2, 33,34,35) )   CALL ctl_stop('psi_h: failed to release workspace arrays.') 
     930         &    + (1. - stabit)*(2.*log( (1. + X2)/2. ))                 ! Unstable 
     931 
     932      IF( wrk_not_released(2, 33,34,35) )   CALL ctl_stop('psi_h: failed to release workspace arrays') 
    939933      ! 
    940934    END FUNCTION psi_h 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r2636 r2690  
    156156#if ! defined key_lim2   &&   ! defined key_lim3 
    157157   ! quick patch to be able to run the coupled model without sea-ice... 
    158    INTEGER, PARAMETER               ::   jpl = 1  
     158   INTEGER, PARAMETER ::   jpl = 1  
    159159   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hicif, hsnif, u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 
    160160   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice ! (jpi,jpj,jpl) 
    161    REAL(wp)                         ::  lfus 
     161   REAL(wp) ::  lfus 
    162162#endif 
    163163 
    … …  
    167167   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    168168   !! $Id$ 
    169    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     169   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    170170   !!---------------------------------------------------------------------- 
    171171 
    … …  
    206206      !!              * initialise the OASIS coupler 
    207207      !!---------------------------------------------------------------------- 
    208       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    209       USE wrk_nemo, ONLY: zacs => wrk_2d_1, zaos => wrk_2d_2 ! clear & overcast sky albedos 
     208      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     209      USE wrk_nemo, ONLY:   zacs => wrk_2d_1 , zaos => wrk_2d_2  ! clear & overcast sky albedos 
    210210      !! 
    211211      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
    212212      !! 
    213       INTEGER                      ::   jn           ! dummy loop index 
     213      INTEGER ::   jn   ! dummy loop index 
    214214      !! 
    215215      NAMELIST/namsbc_cpl/  cn_snd_temperature, cn_snd_albedo    , cn_snd_thickness,                 &           
    … …  
    223223      !!--------------------------------------------------------------------- 
    224224 
    225       IF(wrk_in_use(2, 1,2) ) THEN 
     225      IF( wrk_in_use(2, 1,2) ) THEN 
    226226         CALL ctl_stop('sbc_cpl_init: requested workspace arrays unavailable')   ;   RETURN 
    227227      ENDIF 
    … …  
    563563         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
    564564 
    565       IF( wrk_not_released(2, 1,2) )   CALL ctl_stop('sbc_cpl_init: failed to release workspace arrays.') 
     565      IF( wrk_not_released(2, 1,2) )   CALL ctl_stop('sbc_cpl_init: failed to release workspace arrays') 
    566566      ! 
    567567   END SUBROUTINE sbc_cpl_init 
    … …  
    610610      !!                        emp = emps   evap. - precip. (- runoffs) (- calving) ('ocean only case) 
    611611      !!---------------------------------------------------------------------- 
    612       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    613       USE wrk_nemo, ONLY: ztx => wrk_2d_1, zty => wrk_2d_2 
     612      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     613      USE wrk_nemo, ONLY:   ztx => wrk_2d_1 , zty => wrk_2d_2 
    614614      !! 
    615615      INTEGER, INTENT(in) ::   kt       ! ocean model time step index 
    … …  
    855855      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice at cp_ice_msh point 
    856856      !!---------------------------------------------------------------------- 
    857       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    858       USE wrk_nemo, ONLY: ztx => wrk_2d_1, zty => wrk_2d_2 
     857      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     858      USE wrk_nemo, ONLY:   ztx => wrk_2d_1 , zty => wrk_2d_2 
    859859      !! 
    860860      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2] 
    … …  
    10851085      !!                   sprecip             solid precipitation over the ocean   
    10861086      !!---------------------------------------------------------------------- 
    1087       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    1088       USE wrk_nemo, ONLY: zcptn => wrk_2d_1  ! rcp * tn(:,:,1) 
    1089       USE wrk_nemo, ONLY: ztmp  => wrk_2d_2  ! temporary array 
    1090       USE wrk_nemo, ONLY: zsnow => wrk_2d_3  ! snow precipitation  
    1091       USE wrk_nemo, ONLY: zicefr => wrk_3d_1 ! ice fraction  
     1087      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     1088      USE wrk_nemo, ONLY:   zcptn  => wrk_2d_1   ! rcp * tn(:,:,1) 
     1089      USE wrk_nemo, ONLY:   ztmp   => wrk_2d_2   ! temporary array 
     1090      USE wrk_nemo, ONLY:   zsnow  => wrk_2d_3   ! snow precipitation  
     1091      USE wrk_nemo, ONLY:   zicefr => wrk_3d_1  ! ice fraction  
    10921092      !! 
    10931093      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   p_frld     ! lead fraction                [0 to 1] 
    … …  
    12311231      END SELECT 
    12321232 
    1233       IF( wrk_not_released(2, 1,2,3) .OR.   & 
     1233      IF( wrk_not_released(2, 1,2,3)  .OR.   & 
    12341234          wrk_not_released(3, 1)      )   CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 
    12351235      ! 
    … …  
    12461246      !!              all the needed fields (as defined in sbc_cpl_init) 
    12471247      !!---------------------------------------------------------------------- 
    1248       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    1249       USE wrk_nemo, ONLY: zfr_l => wrk_2d_1 ! 1. - fr_i(:,:) 
    1250       USE wrk_nemo, ONLY: ztmp1 => wrk_2d_2, ztmp2 => wrk_2d_3 
    1251       USE wrk_nemo, ONLY: zotx1=> wrk_2d_4, zoty1=> wrk_2d_5, zotz1=> wrk_2d_6 
    1252       USE wrk_nemo, ONLY: zitx1=> wrk_2d_7, zity1=> wrk_2d_8, zitz1=> wrk_2d_9 
    1253       !! 
     1248      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     1249      USE wrk_nemo, ONLY:   zfr_l => wrk_2d_1  ! 1. - fr_i(:,:) 
     1250      USE wrk_nemo, ONLY:   ztmp1 => wrk_2d_2 , ztmp2 => wrk_2d_3 
     1251      USE wrk_nemo, ONLY:   zotx1 => wrk_2d_4 , zoty1 => wrk_2d_5 , zotz1 => wrk_2d_6 
     1252      USE wrk_nemo, ONLY:   zitx1 => wrk_2d_7 , zity1 => wrk_2d_8 , zitz1 => wrk_2d_9 
     1253      ! 
    12541254      INTEGER, INTENT(in) ::   kt 
    1255       !! 
    1256       INTEGER ::   ji, jj          ! dummy loop indices 
    1257       INTEGER ::   isec, info      ! temporary integer 
     1255      ! 
     1256      INTEGER ::   ji, jj       ! dummy loop indices 
     1257      INTEGER ::   isec, info   ! local integer 
    12581258      !!---------------------------------------------------------------------- 
    12591259 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r2633 r2690  
    5858      !!                   & spread out over erp area depending its sign 
    5959      !!---------------------------------------------------------------------- 
    60       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    61       USE wrk_nemo, ONLY:      ztmsk_neg => wrk_2d_1, ztmsk_pos=> wrk_2d_2 
    62       USE wrk_nemo, ONLY: ztmsk_tospread => wrk_2d_3 
    63       USE wrk_nemo, ONLY:          z_wgt => wrk_2d_4, zerp_cor => wrk_2d_5 
    64       !! 
     60      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     61      USE wrk_nemo, ONLY:   ztmsk_neg      => wrk_2d_1 , ztmsk_pos => wrk_2d_2 
     62      USE wrk_nemo, ONLY:   ztmsk_tospread => wrk_2d_3 
     63      USE wrk_nemo, ONLY:   z_wgt          => wrk_2d_4 , zerp_cor => wrk_2d_5 
     64      ! 
    6565      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    6666      INTEGER, INTENT( in ) ::   kn_fsbc  !  
    6767      INTEGER, INTENT( in ) ::   kn_fwb   ! ocean time-step index 
    68       !! 
    69       INTEGER  ::   inum                  ! temporary logical unit 
    70       INTEGER  ::   ikty, iyear           !  
    71       REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp       ! temporary scalars 
    72       REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread 
     68      ! 
     69      INTEGER  ::   inum, ikty, iyear   ! local integers 
     70      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp   ! local scalars 
     71      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread    !   -      - 
    7372      !!---------------------------------------------------------------------- 
    7473      ! 
    7574      IF( wrk_in_use(2, 1,2,3,4,5) ) THEN 
    7675         CALL ctl_stop('sbc_fwb: requested workspace arrays are unavailable')   ;   RETURN 
    77       END IF 
     76      ENDIF 
    7877      ! 
    7978      IF( kt == nit000 ) THEN 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r2636 r2690  
    5353      !!                fr_i       : update the ice fraction 
    5454      !!--------------------------------------------------------------------- 
    55       INTEGER, INTENT(in)          ::   kt         ! ocean time step 
     55      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    5656      ! 
    5757      INTEGER  ::   ji, jj     ! dummy loop indices 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r2636 r2690  
    8989      !!                utau, vtau, taum, wndm, qns , qsr, emp , emps 
    9090      !!--------------------------------------------------------------------- 
    91       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    92       USE wrk_nemo, ONLY: zalb_ice_os => wrk_3d_1 ! albedo of the ice under overcast sky 
    93       USE wrk_nemo, ONLY: zalb_ice_cs => wrk_3d_2 ! albedo of ice under clear sky 
     91      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     92      USE wrk_nemo, ONLY:   zalb_ice_os => wrk_3d_1 ! albedo of the ice under overcast sky 
     93      USE wrk_nemo, ONLY:   zalb_ice_cs => wrk_3d_2 ! albedo of ice under clear sky 
    9494      !! 
    9595      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    9696      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE) 
    9797      !! 
    98       INTEGER  ::   jl                 ! loop index 
    99       REAL(wp) ::   zcoef              ! temporary scalar 
     98      INTEGER  ::   jl      ! dummy loop index 
     99      REAL(wp) ::   zcoef   ! local scalar 
    100100      !!---------------------------------------------------------------------- 
    101101 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r2636 r2690  
    8383      !!                utau, vtau, taum, wndm, qns , qsr, emp , emps 
    8484      !!--------------------------------------------------------------------- 
    85       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    86       USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2, wrk_3d_3   ! 3D workspace 
     85      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     86      USE wrk_nemo, ONLY:   wrk_3d_1 , wrk_3d_2 , wrk_3d_3   ! 3D workspace 
    8787      !! 
    8888      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    … …  
    9797 
    9898      IF( wrk_in_use(3, 1,2,3) ) THEN 
    99          CALL ctl_stop('sbc_ice_lim_2: requested workspace arrays are unavailable.')   ;   RETURN 
     99         CALL ctl_stop('sbc_ice_lim_2: requested workspace arrays are unavailable')   ;   RETURN 
    100100      ENDIF 
    101101      ! Use pointers to access only sub-arrays of workspaces 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r2676 r2690  
    7575      !!              - nsbc: type of sbc 
    7676      !!---------------------------------------------------------------------- 
    77       INTEGER ::   icpt      ! temporary integer 
     77      INTEGER ::   icpt   ! local integer 
    7878      !! 
    7979      NAMELIST/namsbc/ nn_fsbc   , ln_ana , ln_flx  , ln_blk_clio, ln_blk_core, ln_cpl,   & 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r2676 r2690  
    7777      ALLOCATE( rnfmsk(jpi,jpj)         , rnfmsk_z(jpk)          ,     & 
    7878         &      h_rnf (jpi,jpj)         , nk_rnf  (jpi,jpj)      ,     & 
    79          &      rnf_tsc_b(jpi,jpj,jpts) , rnf_tsc (jpi,jpj,jpts) , STAT=sbc_rnf_alloc) 
     79         &      rnf_tsc_b(jpi,jpj,jpts) , rnf_tsc (jpi,jpj,jpts) , STAT=sbc_rnf_alloc ) 
    8080         ! 
    8181      IF( lk_mpp            )   CALL mpp_sum ( sbc_rnf_alloc ) 
    82       IF( sbc_rnf_alloc > 0 )   CALL ctl_warn('sbc_rnf_alloc: allocation of arrays failed.') 
     82      IF( sbc_rnf_alloc > 0 )   CALL ctl_warn('sbc_rnf_alloc: allocation of arrays failed') 
    8383   END FUNCTION sbc_rnf_alloc 
    8484 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r2620 r2690  
    4949      !!      is add to ssh_m when ln_apr_dyn = T. Required for sea-ice dynamics. 
    5050      !!--------------------------------------------------------------------- 
    51       INTEGER, INTENT(in) ::   kt        ! ocean time step 
     51      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    5252      ! 
    53       REAL(wp) ::   zcoef       ! temporary scalar 
    54       REAL(wp) ::   zf_sbc      ! read sbc frequency  
     53      REAL(wp) ::   zcoef, zf_sbc       ! local scalar 
    5554      !!--------------------------------------------------------------------- 
    5655      !                                                   ! ---------------------------------------- ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r2636 r2690  
    108108      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    109109      !!---------------------------------------------------------------------- 
    110       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    111       USE wrk_nemo, ONLY: zws => wrk_3d_1 ! temporary workspace 
     110      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     111      USE wrk_nemo, ONLY:   zws => wrk_3d_1   ! 3D workspace 
    112112      !! 
    113113      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    114       !                                                               ! 2 : salinity               [psu] 
    115       REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd   ! in situ density  
     114      !                                                      ! 2 : salinity               [psu] 
     115      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd   ! in situ density            [-] 
    116116      !! 
    117117      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    118       REAL(wp) ::   zt , zs , zh , zsr   ! temporary scalars 
    119       REAL(wp) ::   zr1, zr2, zr3, zr4   !    -         - 
    120       REAL(wp) ::   zrhop, ze, zbw, zb   !    -         - 
    121       REAL(wp) ::   zd , zc , zaw, za    !    -         - 
    122       REAL(wp) ::   zb1, za1, zkw, zk0   !    -         - 
    123       REAL(wp) ::   zrau0r               !    -         - 
    124       !!---------------------------------------------------------------------- 
    125  
    126       IF(wrk_in_use(3, 1))THEN 
    127          CALL ctl_stop('eos_insitu : requested workspace array unavailable.') 
    128          RETURN 
    129       END IF 
     118      REAL(wp) ::   zt , zs , zh , zsr   ! local scalars 
     119      REAL(wp) ::   zr1, zr2, zr3, zr4   !   -      - 
     120      REAL(wp) ::   zrhop, ze, zbw, zb   !   -      - 
     121      REAL(wp) ::   zd , zc , zaw, za    !   -      - 
     122      REAL(wp) ::   zb1, za1, zkw, zk0   !   -      - 
     123      REAL(wp) ::   zrau0r               !   -      - 
     124      !!---------------------------------------------------------------------- 
     125 
     126      IF( wrk_in_use(3, 1) ) THEN 
     127         CALL ctl_stop('eos_insitu: requested workspace array unavailable')   ;   RETURN 
     128      ENDIF 
    130129 
    131130      SELECT CASE( nn_eos ) 
    … …  
    192191      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk ) 
    193192      ! 
    194       IF(wrk_not_released(3, 1))THEN 
    195          CALL ctl_stop('eos_insitu : failed to release workspace array.') 
    196       END IF 
     193      IF( wrk_not_released(3, 1) )   CALL ctl_stop('eos_insitu: failed to release workspace array') 
    197194      ! 
    198195   END SUBROUTINE eos_insitu 
    … …  
    245242      !!                Brown and Campana, Mon. Weather Rev., 1978 
    246243      !!---------------------------------------------------------------------- 
    247       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    248       USE wrk_nemo, ONLY: zws => wrk_3d_1 ! 3D workspace 
    249       !! 
    250       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    251       !                                                               ! 2 : salinity               [psu] 
    252       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density  
     244      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     245      USE wrk_nemo, ONLY:   zws => wrk_3d_1 ! 3D workspace 
     246      !! 
     247      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius] 
     248      !                                                                ! 2 : salinity               [psu] 
     249      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-] 
    253250      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
    254  
     251      ! 
    255252      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    256       REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! temporary scalars 
    257       REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r       !    -         - 
    258       !!---------------------------------------------------------------------- 
    259  
    260       IF(wrk_in_use(3, 1))THEN 
    261          CALL ctl_stop('eos_insitu_pot: requested workspace array unavailable.') 
    262          RETURN 
    263       END IF 
     253      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! local scalars 
     254      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r       !   -      - 
     255      !!---------------------------------------------------------------------- 
     256 
     257      IF( wrk_in_use(3, 1) ) THEN 
     258         CALL ctl_stop('eos_insitu_pot: requested workspace array unavailable')   ;   RETURN 
     259      ENDIF 
    264260 
    265261      SELECT CASE ( nn_eos ) 
    … …  
    331327      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
    332328      ! 
    333       IF(wrk_not_released(3, 1))THEN 
    334          CALL ctl_stop('eos_insitu_pot: failed to release workspace array.') 
    335       END IF 
     329      IF( wrk_not_released(3, 1) )   CALL ctl_stop('eos_insitu_pot: failed to release workspace array') 
    336330      ! 
    337331   END SUBROUTINE eos_insitu_pot 
    … …  
    374368      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    375369      !!---------------------------------------------------------------------- 
    376       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    377       USE wrk_nemo, ONLY: zws => wrk_2d_5 ! 2D workspace 
     370      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     371      USE wrk_nemo, ONLY:   zws => wrk_2d_5 ! 2D workspace 
    378372      !! 
    379373      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    … …  
    387381      !!---------------------------------------------------------------------- 
    388382 
    389       IF(wrk_in_use(2, 5))THEN 
    390          CALL ctl_stop('eos_insitu_2d: requested workspace array unavailable.') 
    391          RETURN 
    392       END IF 
    393  
    394       prd(:,:) = 0.e0 
     383      IF( wrk_in_use(2, 5) ) THEN 
     384         CALL ctl_stop('eos_insitu_2d: requested workspace array unavailable')   ;   RETURN 
     385      ENDIF 
     386 
     387      prd(:,:) = 0._wp 
    395388 
    396389      SELECT CASE( nn_eos ) 
    … …  
    464457      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
    465458      ! 
    466       IF(wrk_not_released(2, 5))THEN 
    467          CALL ctl_stop('eos_insitu_2d: failed to release workspace array.') 
    468       END IF 
     459      IF( wrk_not_released(3, 5) )   CALL ctl_stop('eos_insitu_2d: failed to release workspace array') 
    469460      ! 
    470461   END SUBROUTINE eos_insitu_2d 
    … …  
    503494      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    504495      !                                                               ! 2 : salinity               [psu] 
    505       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pn2    ! Brunt-Vaisala frequency [s-1] 
     496      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pn2   ! Brunt-Vaisala frequency    [s-1] 
    506497      !! 
    507498      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    508       REAL(wp) ::   zgde3w, zt, zs, zh, zalbet, zbeta   ! temporary scalars  
     499      REAL(wp) ::   zgde3w, zt, zs, zh, zalbet, zbeta   ! local scalars  
    509500#if defined key_zdfddm 
    510       REAL(wp) ::   zds   ! temporary scalars 
     501      REAL(wp) ::   zds   ! local scalars 
    511502#endif 
    512503      !!---------------------------------------------------------------------- 
    … …  
    522513               DO ji = 1, jpi 
    523514                  zgde3w = grav / fse3w(ji,jj,jk) 
    524                   zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) )          ! potential temperature at w-point 
    525                   zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0   ! salinity anomaly (s-35) at w-point 
    526                   zh = fsdepw(ji,jj,jk)                                     ! depth in meters  at w-point 
     515                  zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) )         ! potential temperature at w-pt 
     516                  zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0  ! salinity anomaly (s-35) at w-pt 
     517                  zh = fsdepw(ji,jj,jk)                                                ! depth in meters  at w-point 
    527518                  ! 
    528519                  zalbet = ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &   ! ratio alpha/beta 
    … …  
    620611      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts            ! pot. temperature & salinity 
    621612      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   palph, pbeta   ! thermal & haline expansion coeff. 
    622       !! 
     613      ! 
    623614      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    624615      REAL(wp) ::   zt, zs, zh   ! local scalars  

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r2636 r2690  
    6363      !!---------------------------------------------------------------------- 
    6464      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    65       USE wrk_nemo, ONLY:   zun => wrk_3d_1, zvn => wrk_3d_2, zwn => wrk_3d_3   ! 3D workspace 
     65      USE wrk_nemo, ONLY:   zun => wrk_3d_1 , zvn => wrk_3d_2 , zwn => wrk_3d_3   ! 3D workspace 
    6666      ! 
    6767      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    … …  
    7070      !!---------------------------------------------------------------------- 
    7171      ! 
    72       IF(wrk_in_use(3, 1,2,3) ) THEN 
     72      IF( wrk_in_use(3, 1,2,3) ) THEN 
    7373         CALL ctl_stop('tra_adv: requested workspace arrays unavailable')   ;   RETURN 
    74       END IF 
     74      ENDIF 
    7575      !                                          ! set time step 
    7676      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    … …  
    132132         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    133133      ! 
    134       IF(wrk_not_released(3,1,2,3) )   CALL ctl_stop('tra_adv: failed to release workspace arrays') 
     134      IF( wrk_not_released(3,1,2,3) )   CALL ctl_stop('tra_adv: failed to release workspace arrays') 
    135135      ! 
    136136   END SUBROUTINE tra_adv 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r2636 r2690  
    3131   USE restart         ! ocean restart 
    3232   USE trc_oce         ! share passive tracers/Ocean variables 
    33    USE lib_mpp           ! MPP library 
     33   USE lib_mpp         ! MPP library 
    3434 
    3535   IMPLICIT NONE 
    … …  
    110110      !!              - save trends if needed 
    111111      !!---------------------------------------------------------------------- 
    112       USE oce         , zwx => ua   ! use ua as workspace 
    113       USE oce         , zwy => va   ! use va as workspace 
    114112      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    115       USE wrk_nemo, ONLY: ztfreez => wrk_2d_1 
    116       USE wrk_nemo, ONLY: zwz => wrk_3d_1, zind => wrk_3d_2 
    117       !! 
     113      USE oce     , ONLY:   zwx => ua       , zwy  => va         ! (ua,va) used as 3D workspace 
     114      USE wrk_nemo, ONLY:   zwz => wrk_3d_1 , zind => wrk_3d_2   ! 3D workspace 
     115      USE wrk_nemo, ONLY:   ztfreez => wrk_2d_1                  ! 2D     - 
     116      ! 
    118117      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    119118      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    … …  
    122121      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    123122      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    124       !! 
    125       INTEGER  ::   ji, jj, jk, jn                   ! dummy loop indices 
    126       INTEGER  ::   ierr                             ! local integer 
    127       REAL(wp) ::   zbtr, ztra                       ! local scalars 
    128       REAL(wp) ::   zfp_ui, zfp_vj, zfp_w            !   -      - 
    129       REAL(wp) ::   zfm_ui, zfm_vj, zfm_w            !   -      - 
    130       REAL(wp) ::   zcofi , zcofj , zcofk            !   -      - 
    131       REAL(wp) ::   zupsut, zcenut                   !   -      - 
    132       REAL(wp) ::   zupsvt, zcenvt                   !   -      - 
    133       REAL(wp) ::   zupst , zcent                    !   -      - 
    134       REAL(wp) ::   zice                             !   -      - 
     123      ! 
     124      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     125      INTEGER  ::   ierr             ! local integer 
     126      REAL(wp) ::   zbtr, ztra                            ! local scalars 
     127      REAL(wp) ::   zfp_ui, zfp_vj, zfp_w, zcofi          !   -      - 
     128      REAL(wp) ::   zfm_ui, zfm_vj, zfm_w, zcofj, zcofk   !   -      - 
     129      REAL(wp) ::   zupsut, zcenut, zupst                 !   -      - 
     130      REAL(wp) ::   zupsvt, zcenvt, zcent, zice           !   -      - 
    135131      !!---------------------------------------------------------------------- 
    136132 
    137133      IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1,2) ) THEN 
    138          CALL ctl_stop('tra_adv_cen2: ERROR: requested workspace arrays unavailable')   ;   RETURN 
    139       END IF 
     134         CALL ctl_stop('tra_adv_cen2: requested workspace arrays unavailable')   ;   RETURN 
     135      ENDIF 
    140136 
    141137      IF( kt == nit000 )  THEN 
    … …  
    279275      ENDIF 
    280276      ! 
    281       IF( wrk_not_released(2, 1) .OR. wrk_not_released(3, 1,2) )THEN 
    282          CALL ctl_stop('tra_adv_cen2: ERROR: failed to release workspace arrays') 
    283       END IF 
     277      IF( wrk_not_released(2, 1)   .OR.   & 
     278          wrk_not_released(3, 1,2) )   CALL ctl_stop('tra_adv_cen2: failed to release workspace arrays') 
    284279      ! 
    285280   END SUBROUTINE tra_adv_cen2 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90

    r2633 r2690  
    2525   USE phycst          ! physical constants 
    2626   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    27    USE diaar5, ONLY :   lk_diaar5 
     27   USE diaar5, ONLY:   lk_diaar5 
    2828# endif   
    2929 
    … …  
    4141   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4242   !! $Id$ 
    43    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    44    !!---------------------------------------------------------------------- 
    45  
     43   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     44   !!---------------------------------------------------------------------- 
    4645CONTAINS 
    4746 
    … …  
    6463      !! ** Action  : - add to p.n the eiv component 
    6564      !!---------------------------------------------------------------------- 
    66       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    67       USE wrk_nemo, ONLY: zu_eiv => wrk_2d_1, zv_eiv => wrk_2d_2, & 
    68                           zw_eiv => wrk_2d_3 
    69 # if defined key_diaeiv  
    70       USE wrk_nemo, ONLY: z2d => wrk_2d_4 
     65      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     66      USE wrk_nemo, ONLY:   zu_eiv => wrk_2d_1 , zv_eiv => wrk_2d_2 , zw_eiv => wrk_2d_3   ! 2D workspace 
     67# if defined key_diaeiv  
     68      USE wrk_nemo, ONLY:   z2d => wrk_2d_4   ! 2D workspace 
    7169#endif 
    7270      INTEGER                         , INTENT(in   ) ::   kt       ! ocean time-step index 
    … …  
    8583 
    8684# if defined key_diaeiv  
    87       IF(wrk_in_use(2, 1,2,3,4))THEN 
    88 #else 
    89       IF(wrk_in_use(2, 1,2,3))THEN 
    90 #endif 
    91          CALL ctl_stop('tra_adv_eiv: ERROR: requested workspace arrays are unavailable.') 
    92          RETURN 
    93       END IF 
     85      IF( wrk_in_use(2, 1,2,3,4) ) THEN 
     86# else 
     87      IF( wrk_in_use(2, 1,2,3)   ) THEN 
     88# endif 
     89         CALL ctl_stop('tra_adv_eiv: requested workspace arrays are unavailable')   ;   RETURN 
     90      ENDIF 
    9491 
    9592      IF( kt == nit000 )  THEN 
    … …  
    194191      !  
    195192# if defined key_diaeiv  
    196       IF(wrk_not_released(2, 1,2,3,4))THEN 
    197 #else 
    198       IF(wrk_not_released(2, 1,2,3))THEN 
    199 #endif 
    200          CALL ctl_stop('tra_adv_eiv: ERROR: failed to release workspace arrays.') 
    201       END IF 
     193      IF( wrk_not_released(2, 1,2,3,4) )   CALL ctl_stop('tra_adv_eiv: failed to release workspace arrays') 
     194# else 
     195      IF( wrk_not_released(2, 1,2,3)   )   CALL ctl_stop('tra_adv_eiv: failed to release workspace arrays') 
     196# endif 
    202197      ! 
    203198    END SUBROUTINE tra_adv_eiv 
    … …  
    212207      CHARACTER(len=3) ::   cdtype 
    213208      REAL, DIMENSION(:,:,:) ::   pun, pvn, pwn 
    214       WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype 
    215       WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 
     209      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 
    216210   END SUBROUTINE tra_adv_eiv 
    217211#endif 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r2633 r2690  
    6161      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 
    6262      !!---------------------------------------------------------------------- 
    63       USE oce         , zwx => ua   ! use ua as workspace 
    64       USE oce         , zwy => va   ! use va as workspace 
    65       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    66       USE wrk_nemo, ONLY: zslpx => wrk_3d_1, zslpy => wrk_3d_2 
    67       !! 
     63      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     64      USE oce     , ONLY:   zwx   => ua       , zwy   => va          ! (ua,va) used as workspace 
     65      USE wrk_nemo, ONLY:   zslpx => wrk_3d_1 , zslpy => wrk_3d_2    ! 3D workspace 
     66      ! 
    6867      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    6968      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    … …  
    7372      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field 
    7473      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    75       !! 
     74      ! 
    7675      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    77       REAL(wp) ::   zu, z0u, zzwx    ! local scalar 
    78       REAL(wp) ::   zv, z0v, zzwy    !   -      - 
    79       REAL(wp) ::   zw, z0w          !   -      - 
    80       REAL(wp) ::   ztra, zbtr, zdt, zalpha 
     76      REAL(wp) ::   zu, z0u, zzwx, zw         ! local scalars 
     77      REAL(wp) ::   zv, z0v, zzwy, z0w        !   -      - 
     78      REAL(wp) ::   ztra, zbtr, zdt, zalpha   !   -      - 
    8179      !!---------------------------------------------------------------------- 
    8280 
    83       IF( wrk_in_use(3, 1,2) )THEN 
    84          CALL ctl_stop('tra_adv_muscl: ERROR: requested workspace arrays unavailable') 
    85          RETURN 
    86       END IF 
     81      IF( wrk_in_use(3, 1,2) ) THEN 
     82         CALL ctl_stop('tra_adv_muscl: requested workspace arrays unavailable')   ;   RETURN 
     83      ENDIF 
    8784 
    8885      IF( kt == nit000 )  THEN 
    … …  
    255252      ENDDO 
    256253      ! 
    257       IF( wrk_not_released(3, 1,2) )THEN 
    258          CALL ctl_stop('tra_adv_muscl: ERROR: requested workspace arrays unavailable') 
    259       END IF 
     254      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('tra_adv_muscl: requested workspace arrays unavailable') 
    260255      ! 
    261256   END SUBROUTINE tra_adv_muscl 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r2633 r2690  
    11MODULE traadv_muscl2 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE  traadv_muscl2  *** 
    44   !! Ocean  tracers:  horizontal & vertical advective trend 
    5    !!============================================================================== 
     5   !!====================================================================== 
    66   !! History :  1.0  !  2002-06  (G. Madec) from traadv_muscl 
    77   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport 
    … …  
    5959      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 
    6060      !!---------------------------------------------------------------------- 
    61       USE oce         , zwx => ua   ! use ua as workspace 
    62       USE oce         , zwy => va   ! use va as workspace 
    63       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    64       USE wrk_nemo, ONLY: zslpx => wrk_3d_1, zslpy => wrk_3d_2 
     61      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     62      USE oce     , ONLY:   zwx   => ua       , zwy   => va         ! (ua,va) used as 3D workspace 
     63      USE wrk_nemo, ONLY:   zslpx => wrk_3d_1 , zslpy => wrk_3d_2   ! 3D workspace 
    6564      !! 
    6665      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    … …  
    7372      !! 
    7473      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    75       REAL(wp) ::   zu, z0u, zzwx    ! local scalar 
    76       REAL(wp) ::   zv, z0v, zzwy    !   -      - 
    77       REAL(wp) ::   zw, z0w          !   -      - 
    78       REAL(wp) ::   ztra, zbtr, zdt, zalpha 
     74      REAL(wp) ::   zu, z0u, zzwx, zw         ! local scalars 
     75      REAL(wp) ::   zv, z0v, zzwy, z0w        !   -      - 
     76      REAL(wp) ::   ztra, zbtr, zdt, zalpha   !   -      - 
    7977      !!---------------------------------------------------------------------- 
    8078 
    81       IF(wrk_in_use(3, 1,2))THEN 
    82          CALL ctl_stop('tra_adv_muscl2: ERROR: requested workspace arrays are unavailable') 
    83          RETURN 
    84       END IF 
     79      IF( wrk_in_use(3, 1,2) ) THEN 
     80         CALL ctl_stop('tra_adv_muscl2: requested workspace arrays are unavailable')   ;   RETURN 
     81      ENDIF 
    8582 
    8683      IF( kt == nit000 )  THEN 
    … …  
    9087         ! 
    9188         l_trd = .FALSE. 
    92          IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
     89         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
    9390      ENDIF 
    9491 
    … …  
    288285      END DO 
    289286      ! 
    290       IF(wrk_not_released(3, 1,2))THEN 
    291          CALL ctl_stop('tra_adv_muscl2: ERROR: failed to release workspace arrays') 
    292       END IF 
     287      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('tra_adv_muscl2: failed to release workspace arrays') 
    293288      ! 
    294289   END SUBROUTINE tra_adv_muscl2 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r2633 r2690  
    115115      !! 
    116116      !!---------------------------------------------------------------------- 
    117       USE oce         , zwx => ua   ! use ua as workspace 
    118       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    119       USE wrk_nemo, ONLY: zfu => wrk_3d_1, zfc => wrk_3d_2, zfd => wrk_3d_3 
    120       !! 
    121       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    122       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    123       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    124       REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
    125       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun             ! i-velocity components 
    126       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    127       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    128       !! 
    129       INTEGER  :: ji, jj, jk, jn           ! dummy loop indices 
    130       REAL(wp) :: ztra, zbtr               ! local scalars 
    131       REAL(wp) :: zdir, zdx, zdt, zmsk     ! local scalars 
     117      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     118      USE oce     , ONLY:   zwx => ua       ! ua used as workspace 
     119      USE wrk_nemo, ONLY:   zfu => wrk_3d_1 , zfc => wrk_3d_2, zfd => wrk_3d_3   ! 3D workspace 
     120      ! 
     121      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     122      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
     123      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
     124      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt       ! vertical profile of tracer time-step 
     125      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun        ! i-velocity components 
     126      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields 
     127      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
     128      !! 
     129      INTEGER  :: ji, jj, jk, jn   ! dummy loop indices 
     130      REAL(wp) :: ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars 
    132131      !---------------------------------------------------------------------- 
    133132      ! 
    134       IF(wrk_in_use(3, 1,2,3))THEN 
    135          CALL ctl_stop('tra_adv_qck_i: ERROR: requested workspace arrays unavailable') 
    136          RETURN 
    137       END IF 
     133      IF( wrk_in_use(3, 1,2,3) ) THEN 
     134         CALL ctl_stop('tra_adv_qck_i: requested workspace arrays unavailable')   ;   RETURN 
     135      ENDIF 
    138136      !                                                          ! =========== 
    139137      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    193191               DO ji = fs_2, fs_jpim1   ! vector opt.                
    194192                  zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 
    195                ENDDO 
     193               END DO 
    196194            END DO 
    197195         END DO 
    … …  
    230228      END DO 
    231229      ! 
    232       IF(wrk_not_released(3, 1,2,3))THEN 
    233          CALL ctl_stop('tra_adv_qck_i: ERROR: failed to release workspace arrays') 
    234       END IF 
     230      IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('tra_adv_qck_i: failed to release workspace arrays') 
    235231      ! 
    236232   END SUBROUTINE tra_adv_qck_i 
    … …  
    242238      !! 
    243239      !!---------------------------------------------------------------------- 
    244       USE oce         , zwy => ua   ! use ua as workspace 
    245       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    246       USE wrk_nemo, ONLY: zfu => wrk_3d_1, zfc => wrk_3d_2, zfd => wrk_3d_3 
    247       !! 
    248       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    249       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    250       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    251       REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
    252       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pvn             ! j-velocity components 
    253       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    254       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    255       !! 
    256       INTEGER  :: ji, jj, jk, jn           ! dummy loop indices 
    257       REAL(wp) :: ztra, zbtr               ! local scalars 
    258       REAL(wp) :: zdir, zdx, zdt, zmsk     ! local scalars 
     240      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     241      USE oce     , ONLY:   zwy => ua       ! ua used as workspace 
     242      USE wrk_nemo, ONLY:   zfu => wrk_3d_1 , zfc => wrk_3d_2, zfd => wrk_3d_3   ! 3D workspace 
     243      ! 
     244      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     245      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
     246      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
     247      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt       ! vertical profile of tracer time-step 
     248      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pvn        ! j-velocity components 
     249      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields 
     250      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
     251      !! 
     252      INTEGER  :: ji, jj, jk, jn   ! dummy loop indices 
     253      REAL(wp) :: ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars 
    259254      !---------------------------------------------------------------------- 
    260255      ! 
    … …  
    364359      END DO 
    365360      ! 
    366       IF(wrk_not_released(3, 1,2,3))THEN 
    367          CALL ctl_stop('tra_adv_qck_j: ERROR: failed to release workspace arrays') 
    368       END IF 
     361      IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('tra_adv_qck_j: failed to release workspace arrays') 
    369362      ! 
    370363   END SUBROUTINE tra_adv_qck_j 
    … …  
    376369      !! 
    377370      !!---------------------------------------------------------------------- 
    378       USE oce         , zwz => ua   ! use ua as workspace 
    379       !! 
    380       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    381       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    382       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    383       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pwn             ! vertical velocity  
    384       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn             ! before and now tracer fields 
    385       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    386       !! 
     371      USE oce, ONLY:   zwz => ua   ! ua used as workspace 
     372      ! 
     373      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index 
     374      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
     375      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers 
     376      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pwn      ! vertical velocity  
     377      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn      ! before and now tracer fields 
     378      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend  
     379      ! 
    387380      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    388       REAL(wp) ::   zbtr , ztra      ! temporary scalars 
     381      REAL(wp) ::   zbtr , ztra      ! local scalars 
    389382      !!---------------------------------------------------------------------- 
    390383 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r2663 r2690  
    2525   USE dom_oce         ! ocean space and time domain 
    2626   USE trdmod_oce      ! tracers trends 
    27    USE trdtra      ! tracers trends 
     27   USE trdtra          ! tracers trends 
    2828   USE in_out_manager  ! I/O manager 
    2929   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    30    USE lib_mpp 
     30   USE lib_mpp         ! MPP library 
    3131   USE lbclnk          ! ocean lateral boundary condition (or mpp link)  
    3232   USE diaptr          ! poleward transport diagnostics 
    … …  
    3939   PUBLIC   tra_adv_tvd    ! routine called by step.F90 
    4040 
    41    LOGICAL  :: l_trd       ! flag to compute trends 
     41   LOGICAL ::   l_trd   ! flag to compute trends 
    4242 
    4343   !! * Substitutions 
    … …  
    6666      !!             - save the trends  
    6767      !!---------------------------------------------------------------------- 
    68       USE oce         , zwx => ua   ! use ua as workspace 
    69       USE oce         , zwy => va   ! use va as workspace 
    70       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    71       USE wrk_nemo, ONLY: zwi => wrk_3d_12, zwz => wrk_3d_13 
    72       !! 
     68      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     69      USE oce     , ONLY:   zwx => ua        , zwy => va          ! (ua,va) used as workspace 
     70      USE wrk_nemo, ONLY:   zwi => wrk_3d_12 , zwz => wrk_3d_13   ! 3D workspace 
     71      ! 
    7372      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    7473      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    … …  
    7877      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    7978      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    80       !! 
     79      ! 
    8180      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices   
    8281      REAL(wp) ::   z2dtt, zbtr, ztra        ! local scalar 
    8382      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      - 
    8483      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      - 
    85  
    8684      REAL(wp), DIMENSION (:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz 
    8785      !!---------------------------------------------------------------------- 
    8886 
    89       IF(wrk_in_use(3, 12,13))THEN 
    90          CALL ctl_stop('tra_adv_tvd: ERROR: requested workspace arrays unavailable') 
    91          RETURN 
    92       END IF 
     87      IF( wrk_in_use(3, 12,13) ) THEN 
     88         CALL ctl_stop('tra_adv_tvd: requested workspace arrays unavailable')   ;   RETURN 
     89      ENDIF 
    9390 
    9491      IF( kt == nit000 )  THEN 
    … …  
    242239         ENDIF 
    243240         ! 
    244       ENDDO 
     241      END DO 
    245242      ! 
    246243      IF( l_trd )  THEN 
    … …  
    248245      END IF 
    249246      ! 
    250       IF(wrk_not_released(3, 12,13))THEN 
    251          CALL ctl_stop('tra_adv_tvd: ERROR: failed to release workspace arrays') 
    252       END IF 
     247      IF( wrk_not_released(3, 12,13) )   CALL ctl_stop('tra_adv_tvd: failed to release workspace arrays') 
    253248      ! 
    254249   END SUBROUTINE tra_adv_tvd 
    … …  
    268263      !!       in-space based differencing for fluid 
    269264      !!---------------------------------------------------------------------- 
    270       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    271       USE wrk_nemo, ONLY: zbetup => wrk_3d_8, zbetdo => wrk_3d_9, & 
    272                           zbup => wrk_3d_10, zbdo => wrk_3d_11 
     265      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     266      USE wrk_nemo, ONLY:   zbetup => wrk_3d_8  , zbetdo => wrk_3d_9    ! 3D workspace 
     267      USE wrk_nemo, ONLY:   zbup   => wrk_3d_10 , zbdo   => wrk_3d_11   !  -     - 
     268      ! 
    273269      REAL(wp), DIMENSION(jpk)         , INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
    274270      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field 
    275271      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions 
    276       !! 
    277       INTEGER ::   ji, jj, jk               ! dummy loop indices 
    278       INTEGER ::   ikm1 
    279       REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt 
    280       REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv 
    281       REAL(wp) ::   zup, zdo 
    282       !!---------------------------------------------------------------------- 
    283  
    284       IF(wrk_in_use(3, 8,9,10,11))THEN 
    285          CALL ctl_stop('nonosc: ERROR: requested workspace array unavailable') 
    286          RETURN 
    287       END IF 
    288  
    289       zbig = 1.e+40 
    290       zrtrn = 1.e-15 
    291       zbetup(:,:,jpk) = 0.e0   ;   zbetdo(:,:,jpk) = 0.e0 
     272      ! 
     273      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     274      INTEGER ::   ikm1         ! local integer 
     275      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! local scalars 
     276      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      - 
     277      !!---------------------------------------------------------------------- 
     278 
     279      IF( wrk_in_use(3, 8,9,10,11) ) THEN 
     280         CALL ctl_stop('nonosc: requested workspace array unavailable')   ;   RETURN 
     281      ENDIF 
     282 
     283      zbig  = 1.e+40_wp 
     284      zrtrn = 1.e-15_wp 
     285      zbetup(:,:,jpk) = 0._wp   ;   zbetdo(:,:,jpk) = 0._wp 
    292286 
    293287 
    … …  
    365359      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign) 
    366360      ! 
    367       IF(wrk_not_released(3, 8,9,10,11))THEN 
    368          CALL ctl_stop('nonosc: ERROR: failed to release workspace arrays') 
    369       END IF 
     361      IF( wrk_not_released(3, 8,9,10,11) )   CALL ctl_stop('nonosc: failed to release workspace arrays') 
    370362      ! 
    371363   END SUBROUTINE nonosc 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r2633 r2690  
    7373      !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741.  
    7474      !!---------------------------------------------------------------------- 
    75       USE oce         , zwx => ua   ! use ua as workspace 
    76       USE oce         , zwy => va   ! use va as workspace 
    77       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    78       USE wrk_nemo, ONLY: ztu  => wrk_3d_1, ztv  => wrk_3d_2, & 
    79                           zltu => wrk_3d_3, zltv => wrk_3d_4, & 
    80                           zti  => wrk_3d_5, ztw  => wrk_3d_6 
    81       !! 
     75      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     76      USE oce     , ONLY:   zwx  => ua       , zwy  => va         ! (ua,va) used as workspace 
     77      USE wrk_nemo, ONLY:   ztu  => wrk_3d_1 , ztv  => wrk_3d_2   ! 3D workspace 
     78      USE wrk_nemo, ONLY:   zltu => wrk_3d_3 , zltv => wrk_3d_4   !  -      - 
     79      USE wrk_nemo, ONLY:   zti  => wrk_3d_5 , ztw  => wrk_3d_6   !  -      - 
     80      ! 
    8281      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    8382      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    … …  
    8786      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    8887      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    89       !! 
    90       INTEGER  ::   ji, jj, jk, jn          ! dummy loop indices 
    91       REAL(wp) ::   ztra, zbtr, zcoef       ! local scalars 
    92       REAL(wp) ::   zfp_ui, zfm_ui, zcenut  !   -      - 
    93       REAL(wp) ::   zfp_vj, zfm_vj, zcenvt  !   -      - 
    94       REAL(wp) ::   z2dtt                   !   -      - 
    95       REAL(wp) ::   ztak, zfp_wk, zfm_wk    !   -      - 
    96       REAL(wp) ::   zeeu, zeev, z_hdivn     !   -      - 
     88      ! 
     89      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     90      REAL(wp) ::   ztra, zbtr, zcoef, z2dtt                       ! local scalars 
     91      REAL(wp) ::   zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk   !   -      - 
     92      REAL(wp) ::   zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn    !   -      - 
    9793      !!---------------------------------------------------------------------- 
    9894 
    9995      IF( wrk_in_use(3, 1,2,3,4,5,6) )THEN 
    100          CALL ctl_stop('tra_adv_ubs: ERROR: requested workspace arrays unavailable') 
    101          RETURN 
    102       END IF 
     96         CALL ctl_stop('tra_adv_ubs: requested workspace arrays unavailable')   ;   RETURN 
     97      ENDIF 
    10398 
    10499      IF( kt == nit000 )  THEN 
    … …  
    273268      ENDDO 
    274269      ! 
    275       IF( wrk_not_released(3, 1,2,3,4,5,6) )THEN 
    276          CALL ctl_stop('tra_adv_ubs: ERROR: failed to release workspace arrays') 
    277       END IF 
     270      IF( wrk_not_released(3, 1,2,3,4,5,6) )   CALL ctl_stop('tra_adv_ubs: failed to release workspace arrays') 
    278271      ! 
    279272   END SUBROUTINE tra_adv_ubs 
    … …  
    293286      !!       in-space based differencing for fluid 
    294287      !!---------------------------------------------------------------------- 
    295       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    296       USE wrk_nemo, ONLY: zbetup => wrk_3d_1, zbetdo => wrk_3d_2 
    297       !! 
     288      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     289      USE wrk_nemo, ONLY:   zbetup => wrk_3d_1, zbetdo => wrk_3d_2   ! 3D workspace 
     290      ! 
    298291      REAL(wp), INTENT(in   ), DIMENSION(jpk)          ::   p2dt   ! vertical profile of tracer time-step 
    299292      REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field 
    300293      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paft   ! after field 
    301294      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   pcc    ! monotonic flux in the k direction 
    302       !! 
    303       INTEGER  ::   ji, jj, jk               ! dummy loop indices 
    304       INTEGER  ::   ikm1 
    305       REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt 
    306       !!---------------------------------------------------------------------- 
    307  
    308       IF( wrk_in_use(3, 1,2) )THEN 
    309          CALL ctl_stop('nonosc_z: ERROR: requested workspace arrays unavailable') 
    310          RETURN 
    311       END IF 
    312  
    313       zbig = 1.e+40 
    314       zrtrn = 1.e-15 
    315       zbetup(:,:,:) = 0.e0   ;   zbetdo(:,:,:) = 0.e0 
     295      ! 
     296      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     297      INTEGER  ::   ikm1         ! local integer 
     298      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! local scalars 
     299      !!---------------------------------------------------------------------- 
     300 
     301      IF( wrk_in_use(3, 1,2) ) THEN 
     302         CALL ctl_stop('nonosc_z: requested workspace arrays unavailable')   ;   RETURN 
     303      ENDIF 
     304 
     305      zbig  = 1.e+40_wp 
     306      zrtrn = 1.e-15_wp 
     307      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp 
    316308 
    317309      ! Search local extrema 
    … …  
    381373      END DO 
    382374      ! 
    383       IF( wrk_not_released(3, 1,2) )THEN 
    384          CALL ctl_stop('nonosc_z: ERROR: failed to release workspace arrays') 
    385       END IF 
     375      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('nonosc_z: failed to release workspace arrays') 
    386376      ! 
    387377   END SUBROUTINE nonosc_z 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r2528 r2690  
    6767      !!              Emile-Geay and Madec, 2009, Ocean Science. 
    6868      !!---------------------------------------------------------------------- 
    69       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     69      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7070      !! 
    7171      INTEGER  ::   ji, jj, ik    ! dummy loop indices 
    7272      REAL(wp) ::   zqgh_trd      ! geothermal heat flux trend 
    73       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt 
     73      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt 
    7474      !!---------------------------------------------------------------------- 
    7575      ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r2633 r2690  
    8282         &      vtr_bbl  (jpi,jpj) , ahv_bbl  (jpi,jpj) , mbkv_d  (jpi,jpj) , mgrhv(jpi,jpj) ,     & 
    8383         &      ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) ,                                          & 
    84          &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , r1_e1e2t(jpi,jpj)                  , STAT=tra_bbl_alloc) 
     84         &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , r1_e1e2t(jpi,jpj)                  , STAT= tra_bbl_alloc ) 
    8585         ! 
    8686      IF( lk_mpp            )   CALL mpp_sum ( tra_bbl_alloc ) 
    … …  
    172172      USE wrk_nemo, ONLY:   zptb => wrk_2d_1 
    173173      ! 
    174       INTEGER                              , INTENT(in   ) ::   kjpt    ! number of tracers 
    175       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb   ! before and now tracer fields 
    176       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta   ! tracer trend  
     174      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
     175      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
     176      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend  
    177177      ! 
    178178      INTEGER  ::   ji, jj, jn   ! dummy loop indices 
    … …  
    181181      !!---------------------------------------------------------------------- 
    182182      ! 
    183       IF(wrk_in_use(2,1) ) THEN 
     183      IF( wrk_in_use(2,1) ) THEN 
    184184         CALL ctl_stop('tra_bbl_dif: ERROR: requested workspace array unavailable')   ;   RETURN 
    185185      ENDIF 
    … …  
    218218      END DO                                                ! end tracer 
    219219      !                                                     ! =========== 
    220       IF(wrk_not_released(2,1) )   CALL ctl_stop('tra_bbl_dif: failed to release workspace array') 
     220      IF( wrk_not_released(2,1) )   CALL ctl_stop('tra_bbl_dif: failed to release workspace array') 
    221221      ! 
    222222   END SUBROUTINE tra_bbl_dif 
    … …  
    238238      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    239239      !!----------------------------------------------------------------------   
    240       INTEGER                              , INTENT(in   ) ::   kjpt    ! number of tracers 
    241       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb   ! before and now tracer fields 
    242       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta   ! tracer trend  
    243       !! 
     240      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
     241      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
     242      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend  
     243      ! 
    244244      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices 
    245245      INTEGER  ::   iis , iid , ijs , ijd    ! local integers 
    … …  
    385385      !!---------------------------------------------------------------------- 
    386386 
    387       IF(wrk_in_use(2, 1,2,3,4,5) ) THEN 
     387      IF( wrk_in_use(2, 1,2,3,4,5) ) THEN 
    388388         CALL ctl_stop('bbl: requested workspace arrays unavailable')   ;   RETURN 
    389389      ENDIF 
    … …  
    525525      ENDIF 
    526526      ! 
    527       IF(wrk_not_released(2, 1,2,3,4,5) )   CALL ctl_stop('bbl: failed to release workspace arrays') 
     527      IF( wrk_not_released(2, 1,2,3,4,5) )   CALL ctl_stop('bbl: failed to release workspace arrays') 
    528528      ! 
    529529   END SUBROUTINE bbl 
    … …  
    547547      !!---------------------------------------------------------------------- 
    548548 
    549       IF(wrk_in_use(2,1) ) THEN 
     549      IF( wrk_in_use(2,1) ) THEN 
    550550         CALL ctl_stop('tra_bbl_init: requested workspace array unavailable')   ;   RETURN 
    551551      ENDIF 
    … …  
    635635      ENDIF 
    636636      ! 
    637       IF(wrk_not_released(2,1))THEN 
    638          CALL ctl_stop('tra_bbl_init: ERROR: failed to release workspace array') 
    639       END IF 
     637      IF( wrk_not_released(2,1) )   CALL ctl_stop('tra_bbl_init: failed to release workspace array') 
    640638      ! 
    641639   END SUBROUTINE tra_bbl_init 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r2662 r2690  
    7878      !!                ***  FUNCTION tra_bbl_alloc  *** 
    7979      !!---------------------------------------------------------------------- 
    80       ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk) , resto(jpi,jpj,jpk), STAT=tra_dmp_alloc ) 
     80      ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk) , resto(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 
    8181      ! 
    8282      IF( lk_mpp            )   CALL mpp_sum ( tra_dmp_alloc ) 
    83       IF( tra_dmp_alloc > 0 )   CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed.') 
     83      IF( tra_dmp_alloc > 0 )   CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed') 
    8484   END FUNCTION tra_dmp_alloc 
    8585 
    … …  
    206206 
    207207      !                              ! allocate tradmp arrays 
    208       IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init : unable to allocate arrays' ) 
     208      IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' ) 
    209209 
    210210      SELECT CASE ( nn_hdmp ) 
    … …  
    347347      !!---------------------------------------------------------------------- 
    348348 
    349       IF( wrk_in_use(1, 1) .OR. wrk_in_use(2, 1)  .OR.   & 
    350           wrk_in_use(3, 1)   )THEN 
    351          CALL ctl_stop('dtacof: requested workspace arrays unavailable')   ;   RETURN 
     349      IF( wrk_in_use(1, 1) .OR.   & 
     350          wrk_in_use(2, 1) .OR.   & 
     351          wrk_in_use(3, 1)   ) THEN 
     352          CALL ctl_stop('dtacof: requested workspace arrays unavailable')   ;   RETURN 
    352353      ENDIF 
    353354      !                                   ! ==================== 
    … …  
    543544      ENDIF 
    544545      ! 
    545       IF( wrk_not_released(1, 1) .OR. wrk_not_released(2, 1) .OR. & 
     546      IF( wrk_not_released(1, 1) .OR.   & 
     547          wrk_not_released(2, 1) .OR.   & 
    546548          wrk_not_released(3, 1) )   CALL ctl_stop('dtacof: failed to release workspace arrays') 
    547549      ! 
    … …  
    583585      !!---------------------------------------------------------------------- 
    584586 
    585       IF( wrk_in_use(2, 1,2,3,4) .OR.   & 
    586           wrk_in_use(1, 1,2,3,4)  )THEN 
    587          CALL ctl_stop('cofdis: requested workspace arrays unavailable')   ;   RETURN 
    588       END IF 
     587      IF( wrk_in_use(2, 1,2,3,4) .OR.  & 
     588          wrk_in_use(1, 1,2,3,4)  ) THEN 
     589          CALL ctl_stop('cofdis: requested workspace arrays unavailable')   ;   RETURN 
     590      ENDIF 
    589591 
    590592      ALLOCATE( llcotu(jpi,jpj) , llcotv(jpi,jpj) , llcotf(jpi,jpj) ,                        & 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r2660 r2690  
    237237      !! ** Purpose :   initializations of  
    238238      !!---------------------------------------------------------------------- 
    239       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    240       USE wrk_nemo, ONLY: zt_ref => wrk_3d_1, ztb => wrk_3d_2, zavt => wrk_3d_3   ! 3D workspaces 
    241       USE wrk_nemo, ONLY: zs_ref => wrk_3d_4, zsb => wrk_3d_5                     ! 3D workspaces 
    242       !!  
     239      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     240      USE wrk_nemo, ONLY:   zt_ref => wrk_3d_1, ztb => wrk_3d_2, zavt => wrk_3d_3   ! 3D workspaces 
     241      USE wrk_nemo, ONLY:   zs_ref => wrk_3d_4, zsb => wrk_3d_5                     ! 3D workspaces 
     242      ! 
    243243      USE zdf_oce         ! vertical mixing 
    244244      USE trazdf          ! vertical mixing: double diffusion 
    245245      USE zdfddm          ! vertical mixing: double diffusion 
    246       !! 
     246      ! 
    247247      INTEGER  ::   jk              ! Dummy loop indice 
    248248      INTEGER  ::   ierr            ! local integer 
    249       LOGICAL  ::   llsave          ! 
     249      LOGICAL  ::   llsave          ! local logical 
    250250      REAL(wp) ::   zt0, zs0, z12   ! local scalar 
    251251      !!---------------------------------------------------------------------- 
    252252 
    253       IF(wrk_in_use(3, 1,2,3,4,5) ) THEN 
     253      IF( wrk_in_use(3, 1,2,3,4,5) ) THEN 
    254254         CALL ctl_stop('ldf_ano : requested workspace arrays unavailable')   ;   RETURN 
    255255      ENDIF 
    … …  
    320320      avt(:,:,:)        = zavt(:,:,:) 
    321321      ! 
    322       IF(wrk_not_released(3, 1,2,3,4,5) )   CALL ctl_stop('ldf_ano : failed to release workspace arrays') 
     322      IF( wrk_not_released(3, 1,2,3,4,5) )   CALL ctl_stop('ldf_ano: failed to release workspace arrays') 
    323323      ! 
    324324   END SUBROUTINE ldf_ano 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    r2636 r2690  
    7474      !!               biharmonic mixing trend. 
    7575      !!---------------------------------------------------------------------- 
    76       USE oce         , ztu => ua   ! use ua as workspace 
    77       USE oce         , ztv => va   ! use va as workspace 
    78       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    79       USE wrk_nemo, ONLY: zeeu => wrk_2d_1, zeev => wrk_2d_2, zlt => wrk_2d_3 
     76      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     77      USE oce     , ONLY:   ztu  => ua       , ztv  => va                           ! (ua,va) used as workspace 
     78      USE wrk_nemo, ONLY:   zeeu => wrk_2d_1 , zeev => wrk_2d_2 , zlt => wrk_2d_3   ! 2D workspace 
    8079      !! 
    8180      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    … …  
    9089      !!---------------------------------------------------------------------- 
    9190 
    92       IF(wrk_in_use(2, 1,2,3))THEN 
    93          CALL ctl_stop('tra_ldf_bilap: requested workspace arrays unavailable.') 
    94          RETURN 
    95       END IF 
     91      IF( wrk_in_use(2, 1,2,3) ) THEN 
     92         CALL ctl_stop('tra_ldf_bilap: requested workspace arrays unavailable')   ;   RETURN 
     93      ENDIF 
    9694 
    9795      IF( kt == nit000 )  THEN 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r2636 r2690  
    6666      !!               biharmonic mixing trend. 
    6767      !!---------------------------------------------------------------------- 
    68       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    69       USE wrk_nemo, ONLY: wk1 => wrk_4d_1, wk2 => wrk_4d_2 
     68      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     69      USE wrk_nemo, ONLY:   wk1 => wrk_4d_1 , wk2 => wrk_4d_2     ! 4D workspace 
     70      ! 
    7071      INTEGER         , INTENT(in   )                      ::   kt       ! ocean time-step index 
    7172      CHARACTER(len=3), INTENT(in   )                      ::   cdtype   ! =TRA or TRC (tracer indicator) 
    … …  
    7374      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields 
    7475      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend  
    75       !! 
    76       INTEGER ::   ji, jj, jk, jn                 ! dummy loop indices 
    77       !!---------------------------------------------------------------------- 
    78  
    79       IF(wrk_in_use(4, 1,2))THEN 
    80          CALL ctl_stop('tra_ldf_bilapg : requested workspace arrays unavailable.') 
    81          RETURN 
    82       END IF 
     76      ! 
     77      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
     78      !!---------------------------------------------------------------------- 
     79 
     80      IF( wrk_in_use(4, 1,2) ) THEN 
     81         CALL ctl_stop('tra_ldf_bilapg: requested workspace arrays unavailable')   ;   RETURN 
     82      ENDIF 
    8383 
    8484      IF( kt == nit000 )  THEN 
    … …  
    115115      END DO 
    116116      ! 
    117       IF(wrk_not_released(4, 1,2))THEN 
    118          CALL ctl_stop('tra_ldf_bilapg : failed to release workspace arrays.') 
    119       END IF 
     117      IF( wrk_not_released(4, 1,2) )   CALL ctl_stop('tra_ldf_bilapg : failed to release workspace arrays.') 
    120118      ! 
    121119   END SUBROUTINE tra_ldf_bilapg 
    … …  
    160158      !! 
    161159      !!---------------------------------------------------------------------- 
    162       USE oce         , zftv => ua     ! use ua as workspace 
    163       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, wrk_in_use_xz, wrk_not_released_xz 
    164       USE wrk_nemo, ONLY: zftu => wrk_2d_1,  zdkt => wrk_2d_2, zdk1t => wrk_2d_3 
    165       USE wrk_nemo, ONLY: zftw => wrk_xz_1, zdit => wrk_xz_2, & 
    166                           zdjt => wrk_xz_3, zdj1t => wrk_xz_4 
    167       !! 
     160      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released, wrk_in_use_xz, wrk_not_released_xz 
     161      USE oce     , ONLY:   zftv => ua       ! ua used as workspace 
     162      USE wrk_nemo, ONLY:   zftu => wrk_2d_1 , zdkt  => wrk_2d_2 , zdk1t => wrk_2d_3 
     163      USE wrk_nemo, ONLY:   zftw => wrk_xz_1 , zdit  => wrk_xz_2  
     164      USE wrk_nemo, ONLY:   zdjt => wrk_xz_3 , zdj1t => wrk_xz_4 
     165      ! 
    168166      INTEGER         , INTENT(in )                              ::  kt      ! ocean time-step index 
    169167      CHARACTER(len=3), INTENT(in )                              ::  cdtype  ! =TRA or TRC (tracer indicator)  
    … …  
    184182 
    185183      IF( wrk_in_use(2, 1,2,3) .OR. wrk_in_use_xz(1,2,3,4) )THEN 
    186          CALL ctl_stop('ldfght : requested workspace arrays unavailable.') 
    187          RETURN 
    188       END IF 
     184         CALL ctl_stop('ldfght : requested workspace arrays unavailable')   ;   RETURN 
     185      ENDIF 
    189186      ! 
    190187      DO jn = 1, kjpt 
    … …  
    338335      END DO 
    339336      ! 
    340       IF( wrk_not_released(2, 1,2,3) .OR. wrk_not_released_xz(1,2,3,4) )THEN 
    341          CALL ctl_stop('ldfght : failed to release workspace arrays.') 
    342       END IF 
     337      IF( wrk_not_released(2, 1,2,3)   .OR.   & 
     338          wrk_not_released_xz(1,2,3,4) )   CALL ctl_stop('ldfght : failed to release workspace arrays.') 
    343339      ! 
    344340   END SUBROUTINE ldfght 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r2633 r2690  
    9090      !! ** Action :   Update pta arrays with the before rotated diffusion 
    9191      !!---------------------------------------------------------------------- 
    92       USE oce         , zftu => ua   ! use ua as workspace 
    93       USE oce         , zftv => va   ! use va as workspace 
    94       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    95       USE wrk_nemo, ONLY: zdkt => wrk_2d_1, zdk1t => wrk_2d_2   ! 2D workspace 
    96       USE wrk_nemo, ONLY: zdit => wrk_3d_1, zdjt => wrk_3d_2, ztfw => wrk_3d_3   ! 3D workspace 
    97       USE wrk_nemo, ONLY: z2d => wrk_2d_3   ! 2D workspace - used if key_diaar5 
    98       !! 
     92      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     93      USE oce     , ONLY:   zftu => ua       , zftv  => va         ! (ua,va) used as workspace 
     94      USE wrk_nemo, ONLY:   zdkt => wrk_2d_1 , zdk1t => wrk_2d_2 , z2d  => wrk_2d_3   ! 2D workspace 
     95      USE wrk_nemo, ONLY:   zdit => wrk_3d_1 , zdjt  => wrk_3d_2 , ztfw => wrk_3d_3   ! 3D workspace 
     96      ! 
    9997      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    10098      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    … …  
    104102      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    105103      REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef 
    106       !! 
     104      ! 
    107105      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    108106      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars 
    … …  
    114112      !!---------------------------------------------------------------------- 
    115113 
    116       IF( wrk_in_use(3, 1,2,3) .OR. wrk_in_use(2, 1,2,3) )THEN 
    117           CALL ctl_stop('tra_ldf_iso : requested workspace array unavailable.') 
    118           RETURN 
    119       END IF 
     114      IF( wrk_in_use(3, 1,2,3) .OR. wrk_in_use(2, 1,2,3) ) THEN 
     115          CALL ctl_stop('tra_ldf_iso : requested workspace array unavailable')   ;   RETURN 
     116      ENDIF 
    120117 
    121118      IF( kt == nit000 )  THEN 
    … …  
    294291      END DO 
    295292      ! 
    296       IF( wrk_not_released(3, 1,2,3) .OR.  & 
    297           wrk_not_released(2, 1,2,3) )THEN 
    298           CALL ctl_stop('tra_ldf_iso : failed to release workspace arrays.') 
    299       END IF 
     293      IF( wrk_not_released(3, 1,2,3) .OR.   & 
     294          wrk_not_released(2, 1,2,3) )   CALL ctl_stop('tra_ldf_iso: failed to release workspace arrays') 
    300295      ! 
    301296   END SUBROUTINE tra_ldf_iso 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r2636 r2690  
    9292      USE oce     , ONLY:   zftu => ua       , zftv => va            ! (ua,va) used as 3D workspace 
    9393      USE wrk_nemo, ONLY:   zdit => wrk_3d_1 , zdjt => wrk_3d_2 , ztfw => wrk_3d_3   ! 3D workspace 
    94       USE wrk_nemo, ONLY:   z2d  => wrk_2d_1                                          ! 2D workspace 
    95       !! 
     94      USE wrk_nemo, ONLY:   z2d  => wrk_2d_1                                         ! 2D workspace 
     95      ! 
    9696      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    9797      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    … …  
    101101      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    102102      REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef 
    103       !! 
     103      ! 
    104104      INTEGER  ::  ji, jj, jk,jn   ! dummy loop indices 
    105105      INTEGER  ::  ip,jp,kp        ! dummy loop indices 
    … …  
    114114      REAL(wp) ::   zah, zah_slp, zaei_slp 
    115115#if defined key_diaar5 
    116       REAL(wp)                         ::   zztmp              ! local scalar 
     116      REAL(wp) ::   zztmp              ! local scalar 
    117117#endif 
    118118      !!---------------------------------------------------------------------- 
    119119 
    120120      IF( wrk_in_use(3, 1,2,3) .OR. wrk_in_use(2, 1) ) THEN 
    121          CALL ctl_stop('tra_ldf_iso_grif : requested workspace arrays unavailable.')   ;   RETURN 
     121         CALL ctl_stop('tra_ldf_iso_grif: requested workspace arrays unavailable.')   ;   RETURN 
    122122      ENDIF 
    123123      ! ARP - line below uses 'bounds re-mapping' which is only defined in 
    … …  
    348348      END DO 
    349349      ! 
    350       IF( wrk_not_released(3, 1,2,3,4) .OR. wrk_not_released(2, 1) )THEN 
    351          CALL ctl_stop('tra_ldf_iso_grif : failed to release workspace arrays.') 
    352       END IF 
     350      IF( wrk_not_released(3, 1,2,3,4) .OR.   & 
     351          wrk_not_released(2, 1)       )   CALL ctl_stop('tra_ldf_iso_grif: failed to release workspace arrays') 
    353352      ! 
    354353  END SUBROUTINE tra_ldf_iso_grif 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r2625 r2690  
    6363      !!                harmonic mixing trend. 
    6464      !!---------------------------------------------------------------------- 
    65       USE oce ,   ztu => ua   ! use ua as workspace 
    66       USE oce ,   ztv => va   ! use va as workspace 
    67       !! 
     65      USE oce, ONLY:   ztu => ua , ztv => va  ! (ua,va) used as workspace 
     66      ! 
    6867      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    6968      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    … …  
    7271      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
    7372      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    74       !! 
     73      ! 
    7574      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices 
    7675      INTEGER  ::   iku, ikv, ierr       ! local integers 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90

    r2636 r2690  
    5656      !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371. 
    5757      !!---------------------------------------------------------------------- 
    58       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, wrk_in_use_xz, wrk_not_released_xz 
    59       USE wrk_nemo, ONLY: ztrdt => wrk_3d_1, ztrds => wrk_3d_2, zrhop => wrk_3d_3 
    60       USE wrk_nemo, ONLY: zwx => wrk_xz_1, zwy => wrk_xz_2, zwz => wrk_xz_3 
    61       !! 
     58      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released, wrk_in_use_xz, wrk_not_released_xz 
     59      USE wrk_nemo, ONLY:   ztrdt => wrk_3d_1 , ztrds => wrk_3d_2 , zrhop => wrk_3d_3 
     60      USE wrk_nemo, ONLY:   zwx   => wrk_xz_1 , zwy   => wrk_xz_2 , zwz  => wrk_xz_3 
     61      ! 
    6262      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    63       !! 
     63      ! 
    6464      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    6565      INTEGER  ::   inpcc        ! number of statically instable water column 
    … …  
    7272      ! Strictly 1 and 2 3D workspaces only needed if(l_trdtra) but it doesn't  
    7373      ! cost us anything and makes code simpler. 
    74       IF( wrk_in_use(3, 1,2,3) .OR. wrk_in_use_xz(1,2,3) )THEN 
    75          CALL ctl_stop('tra_npc: requested workspace arrays unavailable.') 
    76          RETURN 
    77       END IF 
     74      IF( wrk_in_use(3, 1,2,3) .OR. wrk_in_use_xz(1,2,3) ) THEN 
     75         CALL ctl_stop('tra_npc: requested workspace arrays unavailable')   ;   RETURN 
     76      ENDIF 
    7877 
    7978      IF( MOD( kt, nn_npc ) == 0 ) THEN 
    … …  
    205204         ! Lateral boundary conditions on ( ta, sa )   ( Unchanged sign) 
    206205         ! ------------------------------============ 
    207          CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) 
    208          CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
     206         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )   ;   CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
    209207       
    210208 
    … …  
    218216      ENDIF 
    219217      ! 
    220       IF( wrk_not_released(3, 1,2,3)  .OR. wrk_not_released_xz(1,2,3) )THEN 
    221          CALL ctl_stop('tra_npc: failed to release workspace arrays.') 
    222       END IF 
     218      IF( wrk_not_released(3, 1,2,3) .OR.   & 
     219          wrk_not_released_xz(1,2,3) )   CALL ctl_stop('tra_npc: failed to release workspace arrays') 
    223220      ! 
    224221   END SUBROUTINE tra_npc 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r2623 r2690  
    152152         ENDIF 
    153153      ENDIF  
    154  
     154      ! 
    155155#if defined key_agrif 
    156156      ! Update tracer at AGRIF zoom boundaries 
    … …  
    159159      CALL tra_swap 
    160160#endif       
    161  
     161      ! 
    162162      ! trends computation 
    163163      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
    … …  
    171171         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds )  
    172172      END IF 
    173  
     173      ! 
    174174      !                        ! control print 
    175175      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   & 
    … …  
    202202      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T) 
    203203      !!---------------------------------------------------------------------- 
    204       INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index 
    205       CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator) 
    206       INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers 
    207       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields 
    208       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields 
    209       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend 
    210       !! 
     204      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index 
     205      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator) 
     206      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers 
     207      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields 
     208      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields 
     209      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend 
     210      ! 
    211211      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    212212      LOGICAL  ::   ll_tra_hpg       ! local logical 
    … …  
    269269      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T) 
    270270      !!---------------------------------------------------------------------- 
    271       INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index 
    272       CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator) 
    273       INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers 
    274       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields 
    275       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields 
    276       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend 
     271      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index 
     272      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator) 
     273      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers 
     274      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields 
     275      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields 
     276      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend 
    277277      !!      
    278278      LOGICAL  ::   ll_tra, ll_tra_hpg, ll_traqsr   ! local logical 
    279279      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
    280       REAL(wp) ::   ztc_a , ztc_n , ztc_b       ! local scalar 
    281       REAL(wp) ::   ztc_f , ztc_d               !   -      - 
    282       REAL(wp) ::   ze3t_b, ze3t_n, ze3t_a      !   -      - 
    283       REAL(wp) ::   ze3t_f, ze3t_d              !   -      - 
    284       REAL(wp) ::   zfact1, zfact2              !   -      - 
     280      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
     281      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      - 
    285282      !!---------------------------------------------------------------------- 
    286283 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r2636 r2690  
    5959   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    6060   !! $Id$ 
    61    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     61   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6262   !!---------------------------------------------------------------------- 
    63  
    6463CONTAINS 
    6564 
    … …  
    9190      !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516. 
    9291      !!---------------------------------------------------------------------- 
    93       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    94       USE wrk_nemo, ONLY: zekb => wrk_2d_1, zekg => wrk_2d_2, zekr => wrk_2d_3 
    95       USE wrk_nemo, ONLY: ze0 => wrk_3d_1, ze1 => wrk_3d_2, ze2 => wrk_3d_3 
    96       USE wrk_nemo, ONLY: ze3 => wrk_3d_4, zea => wrk_3d_5 
    97       !! 
     92      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     93      USE wrk_nemo, ONLY:   zekb => wrk_2d_1 , zekg => wrk_2d_2 , zekr => wrk_2d_3 
     94      USE wrk_nemo, ONLY:   ze0  => wrk_3d_1 , ze1  => wrk_3d_2 , ze2 => wrk_3d_3 
     95      USE wrk_nemo, ONLY:   ze3  => wrk_3d_4 , zea => wrk_3d_5 
     96      ! 
    9897      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
    99       !! 
     98      ! 
    10099      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    101       INTEGER  ::   irgb                 ! temporary integers 
    102       REAL(wp) ::   zchl, zcoef          ! temporary scalars 
     100      INTEGER  ::   irgb                 ! local integers 
     101      REAL(wp) ::   zchl, zcoef, zfact   ! local scalars 
    103102      REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         - 
    104       REAL(wp) ::   zz0, zz1             !    -         - 
    105       REAL(wp) ::   z1_e3t, zfact        !    -         - 
     103      REAL(wp) ::   zz0, zz1, z1_e3t     !    -         - 
    106104      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt 
    107105      !!---------------------------------------------------------------------- 
    108106 
    109107      IF( wrk_in_use(3, 1,2,3,4,5) .OR. wrk_in_use(2, 1,2,3) )THEN 
    110          CALL ctl_stop('tra_qsr : requested workspace arrays unavailable.') 
    111          RETURN 
    112       END IF 
     108         CALL ctl_stop('tra_qsr: requested workspace arrays unavailable')   ;   RETURN 
     109      ENDIF 
    113110 
    114111      IF( kt == nit000 ) THEN 
    … …  
    291288      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    292289      ! 
    293       IF( wrk_not_released(3, 1,2,3,4,5) .OR. & 
    294           wrk_not_released(2, 1,2,3) )THEN 
    295          CALL ctl_stop('tra_qsr : failed to release workspace arrays.') 
    296       END IF 
     290      IF( wrk_not_released(3, 1,2,3,4,5) .OR.   & 
     291          wrk_not_released(2, 1,2,3)     )   CALL ctl_stop('tra_qsr: failed to release workspace arrays') 
    297292      ! 
    298293   END SUBROUTINE tra_qsr 
    … …  
    316311      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 
    317312      !!---------------------------------------------------------------------- 
    318       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    319       USE wrk_nemo, ONLY: zekb => wrk_2d_1, zekg => wrk_2d_2, zekr => wrk_2d_3 
    320       USE wrk_nemo, ONLY: ze0 => wrk_3d_1, ze1 => wrk_3d_2, ze2 => wrk_3d_3 
    321       USE wrk_nemo, ONLY: ze3 => wrk_3d_4, zea => wrk_3d_5 
    322       !! 
    323       INTEGER  ::   ji, jj, jk            ! dummy loop indices 
    324       INTEGER  ::   irgb, ierror          ! temporary integer 
    325       INTEGER  ::   ioptio, nqsr          ! temporary integer 
    326       REAL(wp) ::   zc0  , zc1, zcoef     ! temporary scalars 
    327       REAL(wp) ::   zc2  , zc3  , zchl    !    -         - 
    328       REAL(wp) ::   zz0  , zz1            !    -         - 
    329       !! 
     313      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     314      USE wrk_nemo, ONLY:   zekb => wrk_2d_1 , zekg => wrk_2d_2 , zekr => wrk_2d_3 
     315      USE wrk_nemo, ONLY:   ze0  => wrk_3d_1 , ze1  => wrk_3d_2 , ze2 => wrk_3d_3 
     316      USE wrk_nemo, ONLY:   ze3  => wrk_3d_4 , zea  => wrk_3d_5 
     317      ! 
     318      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
     319      INTEGER  ::   irgb, ierror, ioptio, nqsr   ! local integer 
     320      REAL(wp) ::   zz0, zc0  , zc1, zcoef       ! local scalars 
     321      REAL(wp) ::   zz1, zc2  , zc3, zchl        !   -      - 
     322      ! 
    330323      CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files 
    331324      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read 
     325      !! 
    332326      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio,   & 
    333327         &                  nn_chldta, rn_abs, rn_si0, rn_si1 
    … …  
    335329 
    336330      IF( wrk_in_use(2, 1,2,3) .OR. wrk_in_use(3, 1,2,3,4,5) )THEN 
    337          CALL ctl_stop('tra_qsr_init: requested workspace arrays unavailable.') 
    338          RETURN 
    339       END IF 
     331         CALL ctl_stop('tra_qsr_init: requested workspace arrays unavailable')   ;   RETURN 
     332      ENDIF 
    340333 
    341334      cn_dir = './'       ! directory in which the model is executed 
    … …  
    511504      ENDIF 
    512505      ! 
    513       IF( wrk_not_released(2, 1,2,3) .OR.   & 
    514           wrk_not_released(3, 1,2,3,4,5) )THEN 
    515          CALL ctl_stop('tra_qsr_init: failed to release workspace arrays.') 
    516       END IF 
     506      IF( wrk_not_released(2, 1,2,3)     .OR.   & 
     507          wrk_not_released(3, 1,2,3,4,5) )   CALL ctl_stop('tra_qsr_init: failed to release workspace arrays') 
    517508      ! 
    518509   END SUBROUTINE tra_qsr_init 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r2528 r2690  
    4040   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4141   !! $Id$ 
    42    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    43    !!---------------------------------------------------------------------- 
    44  
     42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     43   !!---------------------------------------------------------------------- 
    4544CONTAINS 
    4645 
    … …  
    210209               zdep = 1. / h_rnf(ji,jj) 
    211210               zdep = zfact * zdep   
    212                IF ( rnf(ji,jj) .ne. 0.0 ) THEN 
     211               IF ( rnf(ji,jj) /= 0._wp ) THEN 
    213212                  DO jk = 1, nk_rnf(ji,jj) 
    214213                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   & 
    … …  
    216215                     IF( ln_rnf_sal )   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   & 
    217216                                          &               +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep  
    218                   ENDDO 
     217                  END DO 
    219218               ENDIF 
    220             ENDDO   
    221          ENDDO   
     219            END DO   
     220         END DO   
    222221      ENDIF   
    223222!!gm  It should be useless 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traswp.F90

    r2528 r2690  
    1616   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    1717   !! $Id$  
    18    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     18   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    1919   !!---------------------------------------------------------------------- 
    20  
    2120CONTAINS 
    2221 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90

    r2636 r2690  
    7373      !! ** Action : - after tracer fields pta 
    7474      !!--------------------------------------------------------------------- 
    75       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    76       USE wrk_nemo, ONLY: zwx => wrk_3d_1, zwy => wrk_3d_2     ! 3D workspace 
    77       !! 
     75      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     76      USE wrk_nemo, ONLY:   zwx => wrk_3d_1, zwy => wrk_3d_2     ! 3D workspace 
     77      ! 
    7878      INTEGER                              , INTENT(in   ) ::   kt          ! ocean time-step index 
    7979      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype      ! =TRA or TRC (tracer indicator) 
    … …  
    8383      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb         ! before and now tracer fields 
    8484      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta         ! tracer trend  
    85       !!  
     85      ! 
    8686      INTEGER  ::  ji, jj, jk, jn, jl        ! dummy loop indices 
    8787      REAL(wp) ::  zlavmr, zave3r, ze3tr     ! local scalars 
    … …  
    8989      !!--------------------------------------------------------------------- 
    9090 
    91       IF(wrk_in_use(3, 1,2))THEN 
    92          CALL ctl_stop('tra_zdf_exp : requested workspace arrays unavailable.') 
    93          RETURN 
    94       END IF 
     91      IF( wrk_in_use(3, 1,2) ) THEN 
     92         CALL ctl_stop('tra_zdf_exp: requested workspace arrays unavailable')   ;   RETURN 
     93      ENDIF 
    9594 
    9695      IF( kt == nit000 )  THEN 
    … …  
    165164      END DO 
    166165      ! 
    167       IF(wrk_not_released(3, 1,2))THEN 
    168          CALL ctl_stop('tra_zdf_exp : failed to release workspace arrays.') 
    169       END IF 
     166      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('tra_zdf_exp: failed to release workspace arrays') 
    170167      ! 
    171168   END SUBROUTINE tra_zdf_exp 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    r2678 r2690  
    7474      !! ** Action  : - pta  becomes the after tracer 
    7575      !!--------------------------------------------------------------------- 
    76       USE oce    , ONLY :   zwd   => ua   ! ua used as workspace 
    77       USE oce    , ONLY :   zws   => va   ! va  -          - 
    78       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    79       USE wrk_nemo, ONLY: zwi => wrk_3d_1, zwt => wrk_3d_2  ! workspace arrays 
    80       !!  
     76      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     77      USE oce     , ONLY:   zwd => ua       , zws => va         ! (ua,va) used as 3D workspace 
     78      USE wrk_nemo, ONLY:   zwi => wrk_3d_1 , zwt => wrk_3d_2   ! 3D workspace  
     79      ! 
    8180      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index 
    8281      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    … …  
    8584      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields 
    8685      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend  
    87       !! 
    88       INTEGER  ::  ji, jj, jk, jn        ! dummy loop indices 
    89       REAL(wp) ::  zrhs                  ! local scalars 
    90       REAL(wp) ::  ze3tb, ze3tn, ze3ta   ! variable vertical scale factors 
     86      ! 
     87      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
     88      REAL(wp) ::  zrhs, ze3tb, ze3tn, ze3ta   ! local scalars 
    9189      !!--------------------------------------------------------------------- 
    9290 
    93       IF(wrk_in_use(3, 1,2))THEN 
    94          CALL ctl_stop('tra_zdf_imp : requested workspace arrays unavailable.') 
    95          RETURN 
    96       END IF 
     91      IF( wrk_in_use(3, 1,2) ) THEN 
     92         CALL ctl_stop('tra_zdf_imp : requested workspace arrays unavailable.')   ;   RETURN 
     93      ENDIF 
    9794 
    9895      IF( kt == nit000 )  THEN 
    … …  
    114111         ! Build matrix if temperature or salinity (only in double diffusion case) or first passive tracer 
    115112         ! 
    116          IF(  ( cdtype == 'TRA' .AND. ( ( jn == jp_tem ) .OR. ( jn == jp_sal .AND. lk_zdfddm ) ) ) .OR. & 
     113         IF(  ( cdtype == 'TRA' .AND. ( jn == jp_tem .OR. ( jn == jp_sal .AND. lk_zdfddm ) ) ) .OR.  & 
    117114            & ( cdtype == 'TRC' .AND. jn == 1 )  )  THEN 
    118115            ! 
    … …  
    231228      !                                               ! ================= ! 
    232229      ! 
    233       IF(wrk_not_released(3, 1,2))THEN 
    234          CALL ctl_stop('tra_zdf_imp : failed to release workspace arrays.') 
    235       END IF 
     230      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('tra_zdf_imp: failed to release workspace arrays') 
    236231      ! 
    237232   END SUBROUTINE tra_zdf_imp 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90

    r2642 r2690  
    8181      !!              - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points  
    8282      !!---------------------------------------------------------------------- 
    83       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    84       USE wrk_nemo, ONLY: zri => wrk_2d_1, zrj => wrk_2d_2   ! interpolated value of rd 
    85       USE wrk_nemo, ONLY: zhi => wrk_2d_3, zhj => wrk_2d_4   ! depth of interpolation for eos2d 
    86       !! 
     83      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     84      USE wrk_nemo, ONLY:   zri => wrk_2d_1 , zrj => wrk_2d_2   ! interpolated value of rd 
     85      USE wrk_nemo, ONLY:   zhi => wrk_2d_3 , zhj => wrk_2d_4   ! depth of interpolation for eos2d 
     86      ! 
    8787      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index 
    8888      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers 
    … …  
    9191      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
    9292      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad. of prd at u- & v-pts  
    93       !! 
     93      ! 
    9494      INTEGER  ::   ji, jj, jn      ! Dummy loop indices 
    9595      INTEGER  ::   iku, ikv, ikum1, ikvm1   ! partial step level (ocean bottom level) at u- and v-points 
     96      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars 
    9697      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zti, ztj    ! interpolated value of tracer 
    97       REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars 
    9898      !!---------------------------------------------------------------------- 
    9999 
    100100      IF( wrk_in_use(2, 1,2,3,4) ) THEN 
    101          CALL ctl_stop('zps_hde: requested workspace arrays unavailable.')  ;  RETURN 
     101         CALL ctl_stop('zps_hde: requested workspace arrays unavailable')  ;  RETURN 
    102102      END IF 
    103103 
    … …  
    211211      END IF 
    212212      ! 
    213       IF( wrk_not_released(2, 1,2,3,4) ) CALL ctl_stop('zps_hde: failed to release workspace arrays.') 
    214  
     213      IF( wrk_not_released(2, 1,2,3,4) )   CALL ctl_stop('zps_hde: failed to release workspace arrays') 
     214      ! 
    215215      DEALLOCATE( zti ) 
    216216      DEALLOCATE( ztj ) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90

    r2633 r2690  
    4545   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4646   !! $Id$ 
    47    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    48    !!---------------------------------------------------------------------- 
    49  
     47   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     48   !!---------------------------------------------------------------------- 
    5049CONTAINS 
    5150 
    … …  
    5756      !!              momentum equations at every time step frequency nn_trd. 
    5857      !!---------------------------------------------------------------------- 
    59       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptrd2dx             ! Temperature or U trend  
    60       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptrd2dy             ! Salinity    or V trend 
    61       INTEGER                     , INTENT(in   ) ::   ktrd                ! tracer trend index 
    62       CHARACTER(len=3)            , INTENT(in   ) ::   ctype               ! momentum ('DYN') or tracers ('TRA') trends 
     58      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptrd2dx   ! Temperature or U trend  
     59      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptrd2dy   ! Salinity    or V trend 
     60      INTEGER                     , INTENT(in   ) ::   ktrd      ! tracer trend index 
     61      CHARACTER(len=3)            , INTENT(in   ) ::   ctype     ! momentum ('DYN') or tracers ('TRA') trends 
    6362      !! 
    64       INTEGER  ::   ji, jj                                                 ! loop indices 
    65       REAL(wp) ::   zmsku, zbtu, zbt                                       ! temporary scalars 
    66       REAL(wp) ::   zmskv, zbtv                                            !    "         " 
    67       !!---------------------------------------------------------------------- 
    68  
    69  
    70       ! 1. Mask trends 
    71       ! -------------- 
    72  
    73       SELECT CASE( ctype ) 
    74       ! 
    75       CASE( 'DYN' )              ! Momentum 
     63      INTEGER ::   ji, jj   ! loop indices 
     64      !!---------------------------------------------------------------------- 
     65 
     66      SELECT CASE( ctype )    !==  Mask trends  ==! 
     67      ! 
     68      CASE( 'DYN' )                    ! Momentum 
    7669         DO jj = 1, jpjm1 
    7770            DO ji = 1, jpim1 
    78                zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,1) 
    79                zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,1) 
    80                ptrd2dx(ji,jj) = ptrd2dx(ji,jj) * zmsku 
    81                ptrd2dy(ji,jj) = ptrd2dy(ji,jj) * zmskv 
     71               ptrd2dx(ji,jj) = ptrd2dx(ji,jj) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,1) 
     72               ptrd2dy(ji,jj) = ptrd2dy(ji,jj) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,1) 
    8273            END DO 
    8374         END DO 
    84          ptrd2dx(jpi, : ) = 0.e0      ;      ptrd2dy(jpi, : ) = 0.e0 
    85          ptrd2dx( : ,jpj) = 0.e0      ;      ptrd2dy( : ,jpj) = 0.e0 
    86          ! 
    87       CASE( 'TRA' )              ! Tracers 
     75         ptrd2dx(jpi, : ) = 0._wp      ;      ptrd2dy(jpi, : ) = 0._wp 
     76         ptrd2dx( : ,jpj) = 0._wp      ;      ptrd2dy( : ,jpj) = 0._wp 
     77         ! 
     78      CASE( 'TRA' )                    ! Tracers 
    8879         ptrd2dx(:,:) = ptrd2dx(:,:) * tmask_i(:,:) 
    8980         ptrd2dy(:,:) = ptrd2dy(:,:) * tmask_i(:,:) 
    … …  
    9182      END SELECT 
    9283       
    93       ! 2. Basin averaged tracer/momentum trends 
    94       ! ---------------------------------------- 
    95  
    96       SELECT CASE( ctype ) 
    97       ! 
    98       CASE( 'DYN' )              ! Momentum 
    99          umo(ktrd) = 0.e0 
    100          vmo(ktrd) = 0.e0 
     84      SELECT CASE( ctype )    !==  Basin averaged tracer/momentum trends  ==! 
     85      ! 
     86      CASE( 'DYN' )                    ! Momentum 
     87         umo(ktrd) = 0._wp 
     88         vmo(ktrd) = 0._wp 
    10189         ! 
    10290         SELECT CASE( ktrd ) 
    103          ! 
    10491         CASE( jpdyn_trd_swf )         ! surface forcing 
    105             DO jj = 1, jpj 
    106                DO ji = 1, jpi 
    107                   umo(ktrd) = umo(ktrd) + ptrd2dx(ji,jj) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) 
    108                   vmo(ktrd) = vmo(ktrd) + ptrd2dy(ji,jj) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) 
    109                END DO 
    110             END DO 
    111             ! 
     92            umo(ktrd) = SUM( ptrd2dx(:,:) * e1u(:,:) * e2u(:,:) * fse3u(:,:,1) ) 
     93            vmo(ktrd) = SUM( ptrd2dy(:,:) * e1v(:,:) * e2v(:,:) * fse3v(:,:,1) ) 
    11294         END SELECT 
    11395         ! 
    11496      CASE( 'TRA' )              ! Tracers 
    115          tmo(ktrd) = 0.e0 
    116          smo(ktrd) = 0.e0 
    117          DO jj = 1, jpj 
    118             DO ji = 1, jpi 
    119                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) 
    120                tmo(ktrd) =  tmo(ktrd) + ptrd2dx(ji,jj) * zbt 
    121                smo(ktrd) =  smo(ktrd) + ptrd2dy(ji,jj) * zbt 
    122             END DO 
    123          END DO 
    124          ! 
     97         tmo(ktrd) = SUM( ptrd2dx(:,:) * e1e2t(:,:) * fse3t(:,:,1) ) 
     98         smo(ktrd) = SUM( ptrd2dy(:,:) * e1e2t(:,:) * fse3t(:,:,1) ) 
    12599      END SELECT 
    126100       
    127       ! 3. Basin averaged tracer/momentum square trends 
    128       ! ---------------------------------------------- 
    129       ! c a u t i o n: field now 
    130        
    131       SELECT CASE( ctype ) 
     101      SELECT CASE( ctype )    !==  Basin averaged tracer/momentum square trends  ==!   (now field) 
    132102      ! 
    133103      CASE( 'DYN' )              ! Momentum 
    134          hke(ktrd) = 0.e0 
    135          DO jj = 1, jpj 
    136             DO ji = 1, jpi 
    137                zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) 
    138                zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) 
    139                hke(ktrd) = hke(ktrd)   & 
    140                &   + un(ji,jj,1) * ptrd2dx(ji,jj) * zbtu & 
    141                &   + vn(ji,jj,1) * ptrd2dy(ji,jj) * zbtv 
    142             END DO 
    143          END DO 
     104         hke(ktrd) = SUM(   un(:,:,1) * ptrd2dx(:,:) * e1u(:,:) * e2u(:,:) * fse3u(:,:,1)   & 
     105            &             + vn(:,:,1) * ptrd2dy(:,:) * e1v(:,:) * e2v(:,:) * fse3v(:,:,1)   ) 
    144106         ! 
    145107      CASE( 'TRA' )              ! Tracers 
    146          t2(ktrd) = 0.e0 
    147          s2(ktrd) = 0.e0 
    148          DO jj = 1, jpj 
    149             DO ji = 1, jpi 
    150                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) 
    151                t2(ktrd) = t2(ktrd) + ptrd2dx(ji,jj) * zbt * tn(ji,jj,1) 
    152                s2(ktrd) = s2(ktrd) + ptrd2dy(ji,jj) * zbt * sn(ji,jj,1) 
    153             END DO 
    154          END DO 
     108         t2(ktrd) = SUM( ptrd2dx(:,:) * e1e2t(:,:) * fse3t(:,:,1) * tn(:,:,1) ) 
     109         s2(ktrd) = SUM( ptrd2dy(:,:) * e1e2t(:,:) * fse3t(:,:,1) * sn(:,:,1) ) 
    155110         !       
    156111      END SELECT 
    … …  
    166121      !!              momentum equations at every time step frequency nn_trd. 
    167122      !!---------------------------------------------------------------------- 
    168       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dx            ! Temperature or U trend  
    169       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dy            ! Salinity    or V trend 
    170       INTEGER,                          INTENT(in   ) ::   ktrd               ! momentum or tracer trend index 
    171       CHARACTER(len=3),                 INTENT(in   ) ::   ctype              ! momentum ('DYN') or tracers ('TRA') trends 
     123      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dx   ! Temperature or U trend  
     124      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dy   ! Salinity    or V trend 
     125      INTEGER,                          INTENT(in   ) ::   ktrd      ! momentum or tracer trend index 
     126      CHARACTER(len=3),                 INTENT(in   ) ::   ctype     ! momentum ('DYN') or tracers ('TRA') trends 
    172127      !! 
    173       INTEGER ::   ji, jj, jk 
    174       REAL(wp) ::   zbt, zbtu, zbtv, zmsku, zmskv                             ! temporary scalars 
    175       !!---------------------------------------------------------------------- 
    176  
    177       ! 1. Mask the trends 
    178       ! ------------------ 
    179  
    180       SELECT CASE( ctype ) 
     128      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     129      !!---------------------------------------------------------------------- 
     130 
     131      SELECT CASE( ctype )    !==  Mask the trends  ==! 
    181132      ! 
    182133      CASE( 'DYN' )              ! Momentum         
    183          DO jk = 1, jpk 
     134         DO jk = 1, jpkm1 
    184135            DO jj = 1, jpjm1 
    185136               DO ji = 1, jpim1 
    186                   zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
    187                   zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    188                   ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * zmsku 
    189                   ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * zmskv 
     137                  ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
     138                  ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    190139               END DO 
    191140            END DO 
    192141         END DO 
    193          ptrd3dx(jpi, : ,:) = 0.e0      ;      ptrd3dy(jpi, : ,:) = 0.e0 
    194          ptrd3dx( : ,jpj,:) = 0.e0      ;      ptrd3dy( : ,jpj,:) = 0.e0 
     142         ptrd3dx(jpi, : ,:) = 0._wp      ;      ptrd3dy(jpi, : ,:) = 0._wp 
     143         ptrd3dx( : ,jpj,:) = 0._wp      ;      ptrd3dy( : ,jpj,:) = 0._wp 
    195144         ! 
    196145      CASE( 'TRA' )              ! Tracers 
    197          DO jk = 1, jpk 
     146         DO jk = 1, jpkm1 
    198147            ptrd3dx(:,:,jk) = ptrd3dx(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    199148            ptrd3dy(:,:,jk) = ptrd3dy(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    … …  
    202151      END SELECT    
    203152 
    204       ! 2. Basin averaged tracer/momentum trends 
    205       ! ---------------------------------------- 
    206        
    207       SELECT CASE( ctype ) 
     153      SELECT CASE( ctype )    !==  Basin averaged tracer/momentum trends  ==! 
    208154      ! 
    209155      CASE( 'DYN' )              ! Momentum 
    210          umo(ktrd) = 0.e0 
    211          vmo(ktrd) = 0.e0 
    212          DO jk = 1, jpk 
    213             DO jj = 1, jpj 
    214                DO ji = 1, jpi 
    215                   zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    216                   zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
    217                   umo(ktrd) = umo(ktrd) + ptrd3dx(ji,jj,jk) * zbtu 
    218                   vmo(ktrd) = vmo(ktrd) + ptrd3dy(ji,jj,jk) * zbtv 
    219                END DO 
    220             END DO 
     156         umo(ktrd) = 0._wp 
     157         vmo(ktrd) = 0._wp 
     158         DO jk = 1, jpkm1 
     159            umo(ktrd) = umo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk) ) 
     160            vmo(ktrd) = vmo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk) ) 
    221161         END DO 
    222162         ! 
    223163      CASE( 'TRA' )              ! Tracers 
    224          tmo(ktrd) = 0.e0 
    225          smo(ktrd) = 0.e0 
    226          DO jk = 1, jpkm1 
    227             DO jj = 1, jpj 
    228                DO ji = 1, jpi 
    229                   zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)  
    230                   tmo(ktrd) =  tmo(ktrd) + ptrd3dx(ji,jj,jk) * zbt 
    231                   smo(ktrd) =  smo(ktrd) + ptrd3dy(ji,jj,jk) * zbt 
    232                END DO 
    233             END DO 
     164         tmo(ktrd) = 0._wp 
     165         smo(ktrd) = 0._wp 
     166         DO jk = 1, jpkm1 
     167            tmo(ktrd) = tmo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
     168            smo(ktrd) = smo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
    234169         END DO 
    235170         ! 
    236171      END SELECT 
    237172 
    238       ! 3. Basin averaged tracer/momentum square trends 
    239       ! ----------------------------------------------- 
    240       ! c a u t i o n: field now 
    241        
    242       SELECT CASE( ctype ) 
     173      SELECT CASE( ctype )    !==  Basin averaged tracer/momentum square trends  ==!   (now field) 
    243174      ! 
    244175      CASE( 'DYN' )              ! Momentum 
    245          hke(ktrd) = 0.e0 
    246          DO jk = 1, jpk 
    247             DO jj = 1, jpj 
    248                DO ji = 1, jpi 
    249                   zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    250                   zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
    251                   hke(ktrd) = hke(ktrd)   & 
    252                   &   + un(ji,jj,jk) * ptrd3dx(ji,jj,jk) * zbtu & 
    253                   &   + vn(ji,jj,jk) * ptrd3dy(ji,jj,jk) * zbtv 
    254                END DO 
    255             END DO 
     176         hke(ktrd) = 0._wp 
     177         DO jk = 1, jpkm1 
     178            hke(ktrd) = hke(ktrd) + SUM(   un(:,:,jk) * ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk)   & 
     179               &                         + vn(:,:,jk) * ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk)   ) 
    256180         END DO 
    257181         ! 
    258182      CASE( 'TRA' )              ! Tracers 
    259          t2(ktrd) = 0.e0 
    260          s2(ktrd) = 0.e0 
    261          DO jk = 1, jpk 
    262             DO jj = 1, jpj 
    263                DO ji = 1, jpi 
    264                   zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    265                   t2(ktrd) = t2(ktrd) + ptrd3dx(ji,jj,jk) * zbt * tn(ji,jj,jk) 
    266                   s2(ktrd) = s2(ktrd) + ptrd3dy(ji,jj,jk) * zbt * sn(ji,jj,jk) 
    267                END DO 
    268             END DO 
     183         t2(ktrd) = 0._wp 
     184         s2(ktrd) = 0._wp 
     185         DO jk = 1, jpkm1 
     186            t2(ktrd) = t2(ktrd) + SUM( ptrd3dx(ji,jj,jk) * tn(ji,jj,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
     187            s2(ktrd) = s2(ktrd) + SUM( ptrd3dy(ji,jj,jk) * sn(ji,jj,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
    269188         END DO 
    270189         ! 
    … …  
    272191      ! 
    273192   END SUBROUTINE trd_3d 
    274  
    275193 
    276194 
    … …  
    281199      !! ** Purpose :   Read the namtrd namelist 
    282200      !!---------------------------------------------------------------------- 
    283       INTEGER  ::   ji, jj, jk 
    284       REAL(wp) ::   zmskt 
    285 #if  defined key_trddyn 
    286       REAL(wp) ::   zmsku, zmskv 
    287 #endif 
     201      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    288202      !!---------------------------------------------------------------------- 
    289203 
    … …  
    295209 
    296210      ! Total volume at t-points: 
    297       tvolt = 0.e0 
     211      tvolt = 0._wp 
    298212      DO jk = 1, jpkm1 
    299          DO jj = 2, jpjm1 
    300             DO ji = fs_2, fs_jpim1   ! vector opt. 
    301                zmskt = tmask(ji,jj,jk) * tmask_i(ji,jj) 
    302                tvolt = tvolt + zmskt * e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) 
    303             END DO 
    304          END DO 
     213         tvolt = SUM( e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) ) 
    305214      END DO 
    306215      IF( lk_mpp )   CALL mpp_sum( tvolt )   ! sum over the global domain 
    … …  
    310219#if  defined key_trddyn 
    311220      ! Initialization of potential to kinetic energy conversion 
    312       rpktrd = 0.e0 
     221      rpktrd = 0._wp 
    313222 
    314223      ! Total volume at u-, v- points: 
    315       tvolu = 0.e0 
    316       tvolv = 0.e0 
     224      tvolu = 0._wp 
     225      tvolv = 0._wp 
    317226 
    318227      DO jk = 1, jpk 
    319228         DO jj = 2, jpjm1 
    320229            DO ji = fs_2, fs_jpim1   ! vector opt. 
    321                zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
    322                zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    323                tvolu = tvolu + zmsku * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    324                tvolv = tvolv + zmskv * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
     230               tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
     231               tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    325232            END DO 
    326233         END DO 
    … …  
    344251      !! ** Purpose :  write dynamic trends in ocean.output  
    345252      !!---------------------------------------------------------------------- 
    346       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    347       USE wrk_nemo, ONLY: zkepe => wrk_3d_1, zkx => wrk_3d_2, & 
    348                           zky => wrk_3d_3, zkz => wrk_3d_4 
    349       INTEGER, INTENT(in) ::   kt                                  ! ocean time-step index 
    350       !! 
    351       INTEGER  ::   ji, jj, jk 
    352       REAL(wp) ::   ze1e2w, zcof, zbe1ru, zbe2rv, zbtr, ztz, zth   !    "      scalars 
    353       !!---------------------------------------------------------------------- 
    354  
    355       IF(wrk_in_use(3, 1,2,3,4))THEN 
    356          CALL ctl_stop('trd_dwr : requested workspace arrays unavailable.') 
    357          RETURN 
    358       END IF 
     253      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     254      USE wrk_nemo, ONLY:   zkepe => wrk_3d_1 , zkx => wrk_3d_2   ! 3D workspace 
     255      USE wrk_nemo, ONLY:   zky   => wrk_3d_3 , zkz => wrk_3d_4   !  -      - 
     256      ! 
     257      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     258      ! 
     259      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     260      REAL(wp) ::   zcof         ! local scalar 
     261      !!---------------------------------------------------------------------- 
     262 
     263      IF( wrk_in_use(3, 1,2,3,4) ) THEN 
     264         CALL ctl_stop('trd_dwr: requested workspace arrays unavailable')   ;   RETURN 
     265      ENDIF 
    359266 
    360267      ! I. Momentum trends 
    … …  
    366273         ! -------------------------------------------------- 
    367274         ! c a u t i o n here, trends are computed at kt+1 (now , but after the swap) 
    368  
    369          zkx(:,:,:)   = 0.e0 
    370          zky(:,:,:)   = 0.e0 
    371          zkz(:,:,:)   = 0.e0 
    372          zkepe(:,:,:) = 0.e0 
     275         zkx  (:,:,:) = 0._wp 
     276         zky  (:,:,:) = 0._wp 
     277         zkz  (:,:,:) = 0._wp 
     278         zkepe(:,:,:) = 0._wp 
    373279    
    374280         CALL eos( tsn, rhd, rhop )       ! now potential and in situ densities 
    375281 
    376          ! Density flux at w-point 
     282         zcof = 0.5_wp / rau0             ! Density flux at w-point 
     283         zkz(:,:,1) = 0._wp 
    377284         DO jk = 2, jpk 
    378             DO jj = 1, jpj 
    379                DO ji = 1, jpi 
    380                   ze1e2w = 0.5 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) * tmask_i(ji,jj) 
    381                   zkz(ji,jj,jk) = ze1e2w / rau0 * ( rhop(ji,jj,jk) + rhop(ji,jj,jk-1) ) 
     285            zkz(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:) 
     286         END DO 
     287          
     288         zcof   = 0.5_wp / rau0           ! Density flux at u and v-points 
     289         DO jk = 1, jpkm1 
     290            DO jj = 1, jpjm1 
     291               DO ji = 1, jpim1 
     292                  zkx(ji,jj,jk) = zcof * e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 
     293                  zky(ji,jj,jk) = zcof * e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 
    382294               END DO 
    383295            END DO 
    384296         END DO 
    385          zkz(:,:,1) = 0.e0 
    386297          
    387          ! Density flux at u and v-points 
    388          DO jk = 1, jpk 
    389             DO jj = 1, jpjm1 
    390                DO ji = 1, jpim1 
    391                   zcof   = 0.5 / rau0 
    392                   zbe1ru = zcof * e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) 
    393                   zbe2rv = zcof * e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) 
    394                   zkx(ji,jj,jk) = zbe1ru * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 
    395                   zky(ji,jj,jk) = zbe2rv * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 
     298         DO jk = 1, jpkm1                 ! Density flux divergence at t-point 
     299            DO jj = 2, jpjm1 
     300               DO ji = 2, jpim1 
     301                  zkepe(ji,jj,jk) = - (  zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1)               & 
     302                     &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               & 
     303                     &                 + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )   )           & 
     304                     &              / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    396305               END DO 
    397306            END DO 
    398307         END DO 
    399           
    400          ! Density flux divergence at t-point 
    401          DO jk = 1, jpkm1 
    402             DO jj = 2, jpjm1 
    403                DO ji = 2, jpim1 
    404                   zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 
    405                   ztz = - zbtr * (    zkz(ji,jj,jk) - zkz(ji,jj,jk+1) ) 
    406                   zth = - zbtr * (  ( zkx(ji,jj,jk) - zkx(ji-1,jj,jk) )   & 
    407                     &             + ( zky(ji,jj,jk) - zky(ji,jj-1,jk) )  ) 
    408                   zkepe(ji,jj,jk) = (zth + ztz) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    409                END DO 
    410             END DO 
    411          END DO 
    412          zkepe( : , : ,jpk) = 0.e0 
    413          zkepe( : ,jpj, : ) = 0.e0 
    414          zkepe(jpi, : , : ) = 0.e0 
    415308 
    416309         ! I.2 Basin averaged kinetic energy trend 
    417310         ! ---------------------------------------- 
    418          peke = 0.e0 
    419          DO jk = 1,jpk 
    420             DO jj = 1, jpj 
    421                DO ji = 1, jpi 
    422                   peke = peke + zkepe(ji,jj,jk) * grav * fsdept(ji,jj,jk)   & 
    423                      &                     * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    424                END DO 
    425             END DO 
    426          END DO 
     311         peke = 0._wp 
     312         DO jk = 1, jpkm1 
     313            peke = peke + SUM( zkepe(:,:,jk) * fsdept(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
     314         END DO 
     315         peke = grav * peke 
    427316 
    428317         ! I.3 Sums over the global domain 
    … …  
    550439      ENDIF 
    551440      ! 
    552       IF(wrk_not_released(3, 1,2,3,4))THEN 
    553          CALL ctl_stop('trd_dwr : failed to release workspace arrays.') 
    554       END IF 
     441      IF( wrk_not_released(3, 1,2,3,4) )   CALL ctl_stop('trd_dwr: failed to release workspace arrays') 
    555442      ! 
    556443   END SUBROUTINE trd_dwr 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90

    r2633 r2690  
    7171      ! 
    7272      IF( lk_mpp             )   CALL mpp_sum ( trd_mld_alloc ) 
    73       IF( trd_mld_alloc /= 0 )   CALL ctl_warn('trd_mld_alloc: failed to allocate array ndextrd1.') 
     73      IF( trd_mld_alloc /= 0 )   CALL ctl_warn('trd_mld_alloc: failed to allocate array ndextrd1') 
    7474   END FUNCTION trd_mld_alloc 
    7575 
    … …  
    9393      !!            surface and the control surface is called "mixed-layer" 
    9494      !!---------------------------------------------------------------------- 
    95       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    96       USE wrk_nemo, ONLY: zvlmsk => wrk_2d_1 
     95      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     96      USE wrk_nemo, ONLY:   zvlmsk => wrk_2d_1     ! 2D workspace 
    9797      ! 
    9898      INTEGER                         , INTENT( in ) ::   ktrd       ! ocean trend index 
    … …  
    104104      !!---------------------------------------------------------------------- 
    105105 
    106       IF(wrk_in_use(2, 1) ) THEN 
     106      IF( wrk_in_use(2, 1) ) THEN 
    107107         CALL ctl_stop('trd_mld_zint : requested workspace arrays unavailable')   ;   RETURN 
    108108      ENDIF 
    … …  
    195195      END SELECT 
    196196      ! 
    197       IF(wrk_not_released(2, 1) )   CALL ctl_stop('trd_mld_zint : failed to release workspace arrays') 
     197      IF( wrk_not_released(2, 1) )   CALL ctl_stop('trd_mld_zint: failed to release workspace arrays') 
    198198      ! 
    199199   END SUBROUTINE trd_mld_zint 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90

    r2636 r2690  
    129129      trdmld_oce_alloc = MAXVAL( ierr ) 
    130130      IF( lk_mpp                )   CALL mpp_sum ( trdmld_oce_alloc ) 
    131       IF( trdmld_oce_alloc /= 0 )   CALL ctl_warn('trdmld_oce_alloc: failed to allocate arrays.') 
     131      IF( trdmld_oce_alloc /= 0 )   CALL ctl_warn('trdmld_oce_alloc: failed to allocate arrays') 
    132132      ! 
    133133   END FUNCTION trdmld_oce_alloc 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r2636 r2690  
    4040      !!                  ***  FUNCTION trd_tra_alloc  *** 
    4141      !!---------------------------------------------------------------------------- 
    42       ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , STAT=trd_tra_alloc) 
     42      ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , STAT= trd_tra_alloc ) 
    4343      ! 
    4444      IF( lk_mpp             )   CALL mpp_sum ( trd_tra_alloc ) 
    … …  
    6161      !!        nn_ctls > 1  : use fixed level surface jk = nn_ctls 
    6262      !!---------------------------------------------------------------------- 
    63       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    64       USE wrk_nemo, ONLY: ztrds => wrk_3d_1 
     63      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     64      USE wrk_nemo, ONLY:   ztrds => wrk_3d_1   ! 3D workspace 
     65      ! 
    6566      INTEGER                         , INTENT(in)           ::  kt      ! time step 
    6667      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC' 
    … …  
    7273      !!---------------------------------------------------------------------- 
    7374 
    74       IF(wrk_in_use(3, 1) ) THEN 
    75          CALL ctl_stop('trd_tra: requested workspace array unavailable.')   ;   RETURN 
     75      IF( wrk_in_use(3, 1) ) THEN 
     76         CALL ctl_stop('trd_tra: requested workspace array unavailable')   ;   RETURN 
    7677      ENDIF 
    7778 
    … …  
    137138      ENDIF 
    138139      ! 
    139       IF(wrk_not_released(3, 1) )   CALL ctl_stop('trd_tra: failed to release workspace array.') 
     140      IF( wrk_not_released(3, 1) )   CALL ctl_stop('trd_tra: failed to release workspace array') 
    140141      ! 
    141142   END SUBROUTINE trd_tra 
    … …  
    152153      !!                k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] ) 
    153154      !!---------------------------------------------------------------------- 
    154       REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   pf      ! advective flux in one direction 
    155       REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   pun     ! now velocity  in one direction 
    156       REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   ptn     ! now or before tracer  
    157       CHARACTER(len=1), INTENT(in )                                   ::   cdir    ! X/Y/Z direction 
    158       REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk)           ::   ptrd    ! advective trend in one direction 
    159       !! 
    160       INTEGER                          ::   ji, jj, jk   ! dummy loop indices 
    161       INTEGER                          ::   ii, ij, ik   ! index shift function of the direction 
    162       REAL(wp)                         ::   zbtr         ! temporary scalar 
     155      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pf      ! advective flux in one direction 
     156      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pun     ! now velocity  in one direction 
     157      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   ptn     ! now or before tracer  
     158      CHARACTER(len=1), INTENT(in )                         ::   cdir    ! X/Y/Z direction 
     159      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk) ::   ptrd    ! advective trend in one direction 
     160      ! 
     161      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     162      INTEGER  ::   ii, ij, ik   ! index shift function of the direction 
     163      REAL(wp) ::   zbtr         ! local scalar 
    163164      !!---------------------------------------------------------------------- 
    164165 
    … …  
    202203      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pu      ! velocity  
    203204      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable  
    204       WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1) 
    205       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ptra(1,1,1) 
    206       WRITE(*,*) ' "   ": You should not have seen this print! error ?', pu(1,1,1) 
    207       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd 
    208       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktra 
    209       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ctype 
    210       WRITE(*,*) ' "   ": You should not have seen this print! error ?', kt 
     205      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1), ptra(1,1,1), pu(1,1,1),   & 
     206         &                                                               ktrd, ktra, ctype, kt 
    211207   END SUBROUTINE trd_tra 
    212208#   endif 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90

    r2633 r2690  
    44   !! Ocean diagnostics:  momentum trends 
    55   !!===================================================================== 
    6    !! History :  9.0  !  04-06  (L. Brunier, A-M. Treguier) Original code  
    7    !!                 !  04-08  (C. Talandier) New trends organization 
     6   !! History :  1.0  !  04-2006  (L. Brunier, A-M. Treguier) Original code  
     7   !!            2.0  !  04-2008  (C. Talandier) New trends organization 
    88   !!---------------------------------------------------------------------- 
    99#if defined key_trdvor   ||   defined key_esopa 
    … …  
    4141 
    4242   INTEGER ::   nh_t, nmoydpvor, nidvor, nhoridvor, ndimvor1, icount   ! needs for IOIPSL output 
    43    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndexvor1 ! needed for IOIPSL output 
     43   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) ::   ndexvor1  ! needed for IOIPSL output 
    4444   INTEGER ::   ndebug     ! (0/1) set it to 1 in case of problem to have more print 
    4545 
    46    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,  :) ::   vor_avr      ! average 
    47    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,  :) ::   vor_avrb     ! before vorticity (kt-1) 
    48    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,  :) ::   vor_avrbb    ! vorticity at begining of the nwrite-1 timestep averaging period 
    49    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,  :) ::   vor_avrbn    ! after vorticity at time step after the 
    50    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,  :) ::   rotot        ! begining of the NWRITE-1 timesteps 
    51    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,  :) ::   vor_avrtot   ! 
    52    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,  :) ::   vor_avrres   ! 
    53  
    54    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   vortrd  ! curl of trends 
     46   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avr      ! average 
     47   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrb     ! before vorticity (kt-1) 
     48   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrbb    ! vorticity at begining of the nwrite-1 timestep averaging period 
     49   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrbn    ! after vorticity at time step after the 
     50   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   rotot        ! begining of the NWRITE-1 timesteps 
     51   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrtot   ! 
     52   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrres   ! 
     53   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   vortrd       ! curl of trends 
    5554          
    5655   CHARACTER(len=12) ::   cvort 
    … …  
    7170      !!                  ***  ROUTINE trd_vor_alloc  *** 
    7271      !!---------------------------------------------------------------------------- 
    73       ALLOCATE( vor_avr(jpi,jpj),    vor_avrb(jpi,jpj), vor_avrbb(jpi,jpj),  & 
    74          &      vor_avrbn(jpi,jpj),  rotot(jpi,jpj),    vor_avrtot(jpi,jpj), & 
    75          &      vor_avrres(jpi,jpj), vortrd(jpi,jpj,jpltot_vor),             & 
    76          &      ndexvor1(jpi*jpj),   STAT=trd_vor_alloc) 
     72      ALLOCATE( vor_avr   (jpi,jpj) , vor_avrb(jpi,jpj) , vor_avrbb (jpi,jpj) ,   & 
     73         &      vor_avrbn (jpi,jpj) , rotot   (jpi,jpj) , vor_avrtot(jpi,jpj) ,  & 
     74         &      vor_avrres(jpi,jpj) , vortrd  (jpi,jpj,jpltot_vor) ,              & 
     75         &      ndexvor1  (jpi*jpj)                                ,   STAT= trd_vor_alloc ) 
    7776         ! 
    7877      IF( lk_mpp             )   CALL mpp_sum ( trd_vor_alloc ) 
    … …  
    108107      !!      trends output in netCDF format using ioipsl 
    109108      !!---------------------------------------------------------------------- 
    110       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    111       USE wrk_nemo, ONLY: zudpvor => wrk_2d_1, &   ! total cmulative trends 
    112                           zvdpvor => wrk_2d_2 
    113       !! 
     109      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     110      USE wrk_nemo, ONLY:   zudpvor => wrk_2d_1 , zvdpvor => wrk_2d_2   ! total cmulative trends 
     111      ! 
    114112      INTEGER                     , INTENT(in   ) ::   ktrd       ! ocean trend index 
    115113      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   putrdvor   ! u vorticity trend  
    116114      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pvtrdvor   ! v vorticity trend 
    117       !! 
     115      ! 
    118116      INTEGER ::   ji, jj       ! dummy loop indices 
    119117      INTEGER ::   ikbu, ikbv   ! local integers 
    120118      !!---------------------------------------------------------------------- 
    121119 
    122       IF(wrk_in_use(2, 1,2))THEN 
    123          CALL ctl_stop('trd_vor_zint_2d : requested workspace arrays unavailable.') 
    124          RETURN 
    125       END IF 
     120      IF( wrk_in_use(2, 1,2) ) THEN 
     121         CALL ctl_stop('trd_vor_zint_2d: requested workspace arrays unavailable')   ;   RETURN 
     122      ENDIF 
    126123 
    127124      ! Initialization 
    128       zudpvor(:,:) = 0._wp 
    129       zvdpvor(:,:) = 0._wp 
    130       ! 
    131       CALL lbc_lnk( putrdvor,  'U' , -1. )         ! lateral boundary condition on input momentum trends 
    132       CALL lbc_lnk( pvtrdvor,  'V' , -1. ) 
     125      zudpvor(:,:) = 0._wp                 ;   zvdpvor(:,:) = 0._wp 
     126      CALL lbc_lnk( putrdvor, 'U', -1. )   ;   CALL lbc_lnk( pvtrdvor, 'V', -1. )      ! lateral boundary condition 
     127       
    133128 
    134129      !  ===================================== 
    … …  
    172167      ENDIF 
    173168      ! 
    174       IF(wrk_not_released(2, 1,2))THEN 
    175          CALL ctl_stop('trd_vor_zint_2d : failed to release workspace arrays.') 
    176       END IF 
     169      IF( wrk_not_released(2, 1,2) )   CALL ctl_stop('trd_vor_zint_2d : failed to release workspace arrays.') 
    177170      ! 
    178171   END SUBROUTINE trd_vor_zint_2d 
    … …  
    206199      !!      trends output in netCDF format using ioipsl 
    207200      !!---------------------------------------------------------------------- 
    208       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    209       USE wrk_nemo, ONLY: zubet   => wrk_2d_1,   zvbet => wrk_2d_2   ! Beta.V  
    210       USE wrk_nemo, ONLY: zudpvor => wrk_2d_3, zvdpvor => wrk_2d_4   ! total cmulative trends 
    211       !! 
     201      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     202      USE wrk_nemo, ONLY:   zubet   => wrk_2d_1,   zvbet => wrk_2d_2   ! Beta.V  
     203      USE wrk_nemo, ONLY:   zudpvor => wrk_2d_3, zvdpvor => wrk_2d_4   ! total cmulative trends 
     204      ! 
    212205      INTEGER                         , INTENT(in   ) ::   ktrd       ! ocean trend index 
    213206      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   putrdvor   ! u vorticity trend  
    214207      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvtrdvor   ! v vorticity trend 
    215       !! 
    216       INTEGER ::   ji, jj, jk 
     208      ! 
     209      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    217210      !!---------------------------------------------------------------------- 
    218211      
    219       IF(wrk_in_use(2, 1,2,3,4))THEN 
    220          CALL ctl_stop('trd_vor_zint_3d : requested workspace arrays unavailable.') 
    221          RETURN 
    222       END IF 
     212      IF( wrk_in_use(2, 1,2,3,4) ) THEN 
     213         CALL ctl_stop('trd_vor_zint_3d: requested workspace arrays unavailable.')   ;   RETURN 
     214      ENDIF 
    223215 
    224216      ! Initialization 
    … …  
    228220      zvdpvor(:,:) = 0._wp 
    229221      ! 
    230       CALL lbc_lnk( putrdvor, 'U' , -1. )         ! lateral boundary condition on input momentum trends 
    231       CALL lbc_lnk( pvtrdvor, 'V' , -1. ) 
     222      CALL lbc_lnk( putrdvor, 'U', -1. )         ! lateral boundary condition on input momentum trends 
     223      CALL lbc_lnk( pvtrdvor, 'V', -1. ) 
    232224 
    233225      !  ===================================== 
    … …  
    284276      ENDIF 
    285277      ! 
    286       IF(wrk_not_released(2, 1,2,3,4))THEN 
    287          CALL ctl_stop('trd_vor_zint_3d : failed to release workspace arrays.') 
    288       END IF 
     278      IF( wrk_not_released(2, 1,2,3,4) )   CALL ctl_stop('trd_vor_zint_3d: failed to release workspace arrays') 
    289279      ! 
    290280   END SUBROUTINE trd_vor_zint_3d 
    … …  
    298288      !!               and make outputs (NetCDF or DIMG format) 
    299289      !!---------------------------------------------------------------------- 
    300       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    301       USE wrk_nemo, ONLY: zun => wrk_2d_1, zvn => wrk_2d_2 ! 2D workspace 
    302       !! 
     290      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     291      USE wrk_nemo, ONLY:   zun => wrk_2d_1 , zvn => wrk_2d_2 ! 2D workspace 
     292      ! 
    303293      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    304       !! 
     294      ! 
    305295      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    306296      INTEGER  ::   it, itmod        ! local integers 
    … …  
    308298      !!---------------------------------------------------------------------- 
    309299 
    310       IF(wrk_in_use(2, 1,2))THEN 
    311          CALL ctl_stop('trd_vor : requested workspace arrays unavailable.') 
    312          RETURN 
    313       END IF 
     300      IF( wrk_in_use(2, 1,2) ) THEN 
     301         CALL ctl_stop('trd_vor: requested workspace arrays unavailable.')   ;   RETURN 
     302      ENDIF 
    314303 
    315304      !  ================= 
    … …  
    478467      IF( kt == nitend )   CALL histclo( nidvor ) 
    479468      ! 
    480       IF(wrk_not_released(2, 1,2) )   CALL ctl_stop('trd_vor : failed to release workspace arrays') 
     469      IF( wrk_not_released(2, 1,2) )   CALL ctl_stop('trd_vor: failed to release workspace arrays') 
    481470      ! 
    482471   END SUBROUTINE trd_vor 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90

    r2528 r2690  
    44   !! Ocean trends :   set vorticity trend variables 
    55   !!====================================================================== 
    6    !! History :  9.0  ! ??? 
     6   !! History :  9.0  !  04-2006  (L. Brunier, A-M. Treguier) Original code  
    77   !!---------------------------------------------------------------------- 
    88 
    … …  
    1414 
    1515#if defined key_trdvor 
    16    LOGICAL, PUBLIC, PARAMETER ::   lk_trdvor = .TRUE.     !: momentum trend flag 
     16   LOGICAL, PUBLIC, PARAMETER ::   lk_trdvor = .TRUE.    !: momentum trend flag 
    1717#else 
    18    LOGICAL, PUBLIC, PARAMETER ::   lk_trdvor = .FALSE.    !: momentum trend flag 
     18   LOGICAL, PUBLIC, PARAMETER ::   lk_trdvor = .FALSE.   !: momentum trend flag 
    1919#endif 
    20    !!* vorticity trends index 
     20   !                                               !!* vorticity trends index 
    2121   INTEGER, PUBLIC, PARAMETER ::   jpltot_vor = 11  !: Number of vorticity trend terms 
    2222   ! 
    … …  
    3636   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3737   !! $Id$  
    38    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3939   !!====================================================================== 
    4040END MODULE trdvor_oce 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90

    r2636 r2690  
    3737 
    3838 
    39    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(    :) ::   avmb , avtb    !: background profile of avm and avt 
    40    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(  :,:) ::   avtb_2d        !: set in tke_init, for other modif than ice 
    41    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(  :,:) ::   bfrua, bfrva   !: Bottom friction coefficients set in zdfbfr 
     39   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)    ::   avmb , avtb    !: background profile of avm and avt 
     40   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   avtb_2d        !: horizontal shape of background Kz profile 
     41   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)  ::   bfrua, bfrva   !: Bottom friction coefficients set in zdfbfr 
    4242   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avmu , avmv    !: vertical viscosity coef at uw- & vw-pts       [m2/s] 
    4343   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avm  , avt     !: vertical viscosity & diffusivity coef at w-pt [m2/s] 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r2617 r2690  
    179179            CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array 
    180180            CALL iom_close(inum) 
    181             bfrcoef2d(:,:)= rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(:,:) ) 
     181            bfrcoef2d(:,:) = rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(:,:) ) 
    182182         ENDIF 
    183183         bfrua(:,:) = - bfrcoef2d(:,:) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r2636 r2690  
    5252      !!                ***  ROUTINE zdf_ddm_alloc  *** 
    5353      !!---------------------------------------------------------------------- 
    54       ALLOCATE( avs(jpi,jpj,jpk), rrau(jpi,jpj,jpk), STAT = zdf_ddm_alloc ) 
     54      ALLOCATE( avs(jpi,jpj,jpk), rrau(jpi,jpj,jpk), STAT= zdf_ddm_alloc ) 
    5555      ! 
    5656      IF( lk_mpp             )   CALL mpp_sum ( zdf_ddm_alloc ) 
    … …  
    105105      IF( wrk_in_use(2, 1,2,3,4,5) ) THEN 
    106106         CALL ctl_stop('zdf_ddm: Requested workspace arrays already in use')   ;   RETURN 
    107       END IF 
     107      ENDIF 
    108108 
    109109      !                                                ! =============== 
    … …  
    117117            DO ji = 1, jpi 
    118118               ! stability indicator: msks=1 if rn2>0; 0 elsewhere 
    119                IF( rn2(ji,jj,jk) + 1.e-12  <= 0. ) THEN   ;   zmsks(ji,jj) = 0.e0 
    120                ELSE                                       ;   zmsks(ji,jj) = 1.e0 
     119               IF( rn2(ji,jj,jk) + 1.e-12  <= 0. ) THEN   ;   zmsks(ji,jj) = 0._wp 
     120               ELSE                                       ;   zmsks(ji,jj) = 1._wp 
    121121               ENDIF 
    122122               ! salt fingering indicator: msksf=1 if rrau>1; 0 elsewhere             
    123                IF( rrau(ji,jj,jk) <= 1.          ) THEN   ;   zmskf(ji,jj) = 0.e0 
    124                ELSE                                       ;   zmskf(ji,jj) = 1.e0 
     123               IF( rrau(ji,jj,jk) <= 1.          ) THEN   ;   zmskf(ji,jj) = 0._wp 
     124               ELSE                                       ;   zmskf(ji,jj) = 1._wp 
    125125               ENDIF 
    126126               ! diffusive layering indicators:  
    127127               !     ! mskdl1=1 if 0<rrau<1; 0 elsewhere 
    128                IF( rrau(ji,jj,jk) >= 1.          ) THEN   ;   zmskd1(ji,jj) = 0.e0 
    129                ELSE                                       ;   zmskd1(ji,jj) = 1.e0 
     128               IF( rrau(ji,jj,jk) >= 1.          ) THEN   ;   zmskd1(ji,jj) = 0._wp 
     129               ELSE                                       ;   zmskd1(ji,jj) = 1._wp 
    130130               ENDIF 
    131131               !     ! mskdl2=1 if 0<rrau<0.5; 0 elsewhere 
    132                IF( rrau(ji,jj,jk) >= 0.5         ) THEN   ;   zmskd2(ji,jj) = 0.e0 
    133                ELSE                                       ;   zmskd2(ji,jj) = 1.e0 
     132               IF( rrau(ji,jj,jk) >= 0.5         ) THEN   ;   zmskd2(ji,jj) = 0._wp 
     133               ELSE                                       ;   zmskd2(ji,jj) = 1._wp 
    134134               ENDIF 
    135135               !   mskdl3=1 if 0.5<rrau<1; 0 elsewhere 
    136                IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0.e0 
    137                ELSE                                                         ;   zmskd3(ji,jj) = 1.e0 
     136               IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp 
     137               ELSE                                                         ;   zmskd3(ji,jj) = 1._wp 
    138138               ENDIF 
    139139            END DO 
    … …  
    185185      !                                                   ! =============== 
    186186      ! 
    187       CALL lbc_lnk( avt , 'W', 1.0_wp )     ! Lateral boundary conditions   (unchanged sign) 
    188       CALL lbc_lnk( avs , 'W', 1.0_wp ) 
    189       CALL lbc_lnk( avm , 'W', 1.0_wp ) 
    190       CALL lbc_lnk( avmu, 'U', 1.0_wp )  
    191       CALL lbc_lnk( avmv, 'V', 1.0_wp ) 
     187      CALL lbc_lnk( avt , 'W', 1._wp )     ! Lateral boundary conditions   (unchanged sign) 
     188      CALL lbc_lnk( avs , 'W', 1._wp ) 
     189      CALL lbc_lnk( avm , 'W', 1._wp ) 
     190      CALL lbc_lnk( avmu, 'U', 1._wp )  
     191      CALL lbc_lnk( avmv, 'V', 1._wp ) 
    192192 
    193193      IF(ln_ctl) THEN 
    … …  
    214214      !!---------------------------------------------------------------------- 
    215215      ! 
    216       REWIND ( numnam )               ! Read Namelist namzdf_ddm : double diffusion mixing scheme 
    217       READ   ( numnam, namzdf_ddm ) 
     216      REWIND( numnam )                ! Read Namelist namzdf_ddm : double diffusion mixing scheme 
     217      READ  ( numnam, namzdf_ddm ) 
    218218      ! 
    219219      IF(lwp) THEN                    ! Parameter print 
    … …  
    224224         WRITE(numout,*) '      maximum avs for dd mixing      rn_avts   = ', rn_avts 
    225225         WRITE(numout,*) '      heat/salt buoyancy flux ratio  rn_hsbfr  = ', rn_hsbfr 
    226          WRITE(numout,*) 
    227226      ENDIF 
    228227      ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

    r2616 r2690  
    5252      !! References :   Lazar, A., these de l'universite Paris VI, France, 1997 
    5353      !!---------------------------------------------------------------------- 
    54       USE oce,   zavt_evd  =>   ua   ! use ua as workspace 
    55       USE oce,   zavm_evd  =>   va   ! use va as workspace 
    56       !! 
     54      USE oce,   zavt_evd => ua , zavm_evd => va  ! (ua,va) used ua workspace 
     55      ! 
    5756      INTEGER, INTENT( in ) ::   kt   ! ocean time-step indexocean time step 
    58       !! 
     57      ! 
    5958      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    6059      !!---------------------------------------------------------------------- 
    … …  
    7069 
    7170      SELECT CASE ( nn_evdm ) 
    72   
     71      ! 
    7372      CASE ( 1 )           ! enhance vertical eddy viscosity and diffusivity (if rn2<-1.e-12) 
    74  
     73         ! 
    7574         zavm_evd(:,:,:) = avm(:,:,:)           ! set avm prior to evd application 
    7675         ! 
    … …  
    8584#if defined key_zdfkpp 
    8685                  ! no evd mixing in the boundary layer with KPP 
    87                   IF( ( MIN( rn2(ji,jj,jk),  rn2b(ji,jj,jk) ) <= -1.e-12 ) .AND. ( fsdepw(ji,jj,jk) > hkpp(ji,jj) ) ) THEN 
     86                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12  .AND.  fsdepw(ji,jj,jk) > hkpp(ji,jj) ) THEN 
    8887#else 
    89                   IF(   MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 
     88                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 
    9089#endif 
    9190                     avt (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk) 
    … …  
    9998            END DO 
    10099         END DO  
    101          CALL lbc_lnk( avt , 'W', 1. )   ;   CALL lbc_lnk( avm , 'W', 1. )   ! Lateral boundary conditions   (unchanged sign) 
     100         CALL lbc_lnk( avt , 'W', 1. )   ;   CALL lbc_lnk( avm , 'W', 1. )   ! Lateral boundary conditions 
    102101         CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. ) 
    103102         ! 
    … …  
    117116#if defined key_zdfkpp 
    118117                  ! no evd mixing in the boundary layer with KPP 
    119                   IF( ( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) .AND. ( fsdepw(ji,jj,jk) > hkpp(ji,jj) ) ) &           
     118                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12  .AND.  fsdepw(ji,jj,jk) > hkpp(ji,jj)  )  &           
    120119#else 
    121                   IF(   MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) & 
     120                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )  & 
    122121#endif 
    123122                     avt(ji,jj,jk) = rn_avevd * tmask(ji,jj,jk) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r2636 r2690  
    117117      !!---------------------------------------------------------------------- 
    118118      ALLOCATE( en(jpi,jpj,jpk),  mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) ,     & 
    119          &      ustars2(jpi,jpj), ustarb2(jpi,jpj)                      , STAT=zdf_gls_alloc ) 
     119         &      ustars2(jpi,jpj), ustarb2(jpi,jpj)                      , STAT= zdf_gls_alloc ) 
    120120         ! 
    121121      IF( lk_mpp             )   CALL mpp_sum ( zdf_gls_alloc ) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90

    r2616 r2690  
    109109         ioptio = ioptio+1 
    110110      ENDIF 
    111       IF( ioptio == 0 .OR. ioptio > 1 .AND. .NOT. lk_esopa ) & 
     111      IF( ioptio == 0 .OR. ioptio > 1 .AND. .NOT. lk_esopa )   & 
    112112         &   CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' ) 
    113113      ! 
    … …  
    138138      ENDIF 
    139139      IF ( ioptio > 1 .AND. .NOT. lk_esopa )   CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' ) 
    140       IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp ) ) & 
    141          CALL ctl_stop( ' except for TKE, GLS or KPP physics, a convection scheme is', & 
     140      IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp ) )           & 
     141         CALL ctl_stop( ' except for TKE, GLS or KPP physics, a convection scheme is',   & 
    142142         &              ' required: ln_zdfevd or ln_zdfnpc logicals' ) 
    143  
    144143 
    145144      !                               !* Background eddy viscosity and diffusivity profil 
    … …  
    149148      ELSE                                  ! Background profile of avt (fit a theoretical/observational profile (Krauss 1990) 
    150149         avmb(:) = rn_avm0 
    151          avtb(:) = rn_avt0 + ( 3.0e-4 - 2 * rn_avt0 ) * 1.0e-4 * gdepw_0(:)   ! m2/s 
    152          IF(ln_sco .AND. lwp)   CALL ctl_warn( '          avtb profile not valid in sco' ) 
     150         avtb(:) = rn_avt0 + ( 3.e-4_wp - 2._wp * rn_avt0 ) * 1.e-4_wp * gdepw_0(:)   ! m2/s 
     151         IF(ln_sco .AND. lwp)   CALL ctl_warn( 'avtb profile not valid in sco' ) 
    153152      ENDIF 
    154153      ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r2636 r2690  
    129129   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   etmean, eumean, evmean   ! coeff. used for hor. smoothing at t-, u- & v-points 
    130130         
    131   
    132131#if defined key_c1d 
    133132   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rig    !: gradient Richardson number 
    … …  
    165164         &      mols(jpi,jpj,jpk), ekdp(jpi,jpj),                              & 
    166165#endif 
    167          &      STAT=zdf_kpp_alloc ) 
     166         &      STAT= zdf_kpp_alloc ) 
    168167         ! 
    169168      IF( lk_mpp             )   CALL mpp_sum ( zdf_kpp_alloc ) 
    … …  
    275274      !!-------------------------------------------------------------------- 
    276275      
    277       IF( wrk_in_use(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR. & 
    278           wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11)          .OR. & 
     276      IF( wrk_in_use(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR.   & 
     277          wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11)          .OR.   & 
    279278          wrk_in_use_xz(1,2,3)                              ) THEN 
    280279         CALL ctl_stop('zdf_kpp : requested workspace arrays unavailable.')   ;   RETURN 
    281       END IF 
     280      ENDIF 
    282281      ! Set-up pointers to 2D spaces 
    283282!gm      zmoek(1:jpi,0:2) => wrk_2d_5(1:jpi,1:3) 
    … …  
    12351234         ENDIF 
    12361235 
    1237       IF( wrk_not_released(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR. & 
    1238           wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11)          .OR. & 
    1239           wrk_not_released_xz(1,2,3)  )   CALL ctl_stop('zdf_kpp : failed to release workspace arrays') 
     1236      IF( wrk_not_released(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR.   & 
     1237          wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11)          .OR.   & 
     1238          wrk_not_released_xz(1,2,3)                               )   & 
     1239          CALL ctl_stop('zdf_kpp : failed to release workspace arrays') 
    12401240      ! 
    12411241   END SUBROUTINE zdf_kpp 
    … …  
    14421442      ENDIF 
    14431443       
    1444           
    14451444 
    14461445      !set constants not in namelist 
    … …  
    15961595      END DO 
    15971596#endif 
     1597      ! 
    15981598   END SUBROUTINE zdf_kpp_init 
    15991599 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r2636 r2690  
    4040      !!               ***  FUNCTION zdf_mxl_alloc  *** 
    4141      !!---------------------------------------------------------------------- 
    42       ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT=zdf_mxl_alloc) 
     42      ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT= zdf_mxl_alloc ) 
    4343      ! 
    4444      IF( lk_mpp             )   CALL mpp_sum ( zdf_mxl_alloc ) 
    … …  
    6464      !! ** Action  :   nmln, hmld, hmlp, hmlpt 
    6565      !!---------------------------------------------------------------------- 
    66       USE wrk_nemo, ONLY: iwrk_in_use, iwrk_not_released 
    67       USE wrk_nemo, ONLY: imld => iwrk_2d_1    ! 2D integer workspace 
     66      USE wrk_nemo, ONLY:   iwrk_in_use, iwrk_not_released 
     67      USE wrk_nemo, ONLY:   imld => iwrk_2d_1    ! 2D integer workspace 
    6868      !! 
    69       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     69      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7070      !! 
    71       INTEGER                     ::   ji, jj, jk          ! dummy loop indices 
    72       INTEGER                     ::   iikn, iiki          ! temporary integer within a do loop 
    73       REAL(wp)                    ::   zrho_c = 0.01_wp    ! density criterion for mixed layer depth 
    74       REAL(wp)                    ::   zavt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth 
     71      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
     72      INTEGER  ::   iikn, iiki          ! temporary integer within a do loop 
     73      REAL(wp) ::   zrho_c = 0.01_wp    ! density criterion for mixed layer depth 
     74      REAL(wp) ::   zavt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth 
    7575      !!---------------------------------------------------------------------- 
    7676 
    77       IF( iwrk_in_use(2, 1) )THEN 
     77      IF( iwrk_in_use(2, 1) ) THEN 
    7878         CALL ctl_stop('zdf_mxl : requested workspace array unavailable')   ;   RETURN 
    79       END IF 
     79      ENDIF 
    8080 
    8181      IF( kt == nit000 ) THEN 
    … …  
    8383         IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth' 
    8484         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    85          !                              ! allocate zdfmxl arrays 
     85         !                             ! allocate zdfmxl arrays 
    8686         IF( zdf_mxl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl : unable to allocate arrays' ) 
    8787      ENDIF 
    … …  
    113113      IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 ) 
    114114      ! 
    115       IF( iwrk_not_released(2, 1) )   CALL ctl_stop('zdf_mxl : failed to release workspace array') 
     115      IF( iwrk_not_released(2, 1) )   CALL ctl_stop('zdf_mxl: failed to release workspace array') 
    116116      ! 
    117117   END SUBROUTINE zdf_mxl 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90

    r2636 r2690  
    4040   REAL(wp) ::   rn_alp   =   5._wp      ! coefficient of the parameterization 
    4141 
    42    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tmric       ! coef. for the horizontal mean at t-point 
     42   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tmric   !: coef. for the horizontal mean at t-point 
    4343 
    4444   !! * Substitutions 
    … …  
    5555      !!                 ***  FUNCTION zdf_ric_alloc  *** 
    5656      !!---------------------------------------------------------------------- 
    57       ALLOCATE( tmric(jpi,jpj,jpk)     , STAT=zdf_ric_alloc ) 
     57      ALLOCATE( tmric(jpi,jpj,jpk)   , STAT= zdf_ric_alloc ) 
    5858      ! 
    5959      IF( lk_mpp             )   CALL mpp_sum ( zdf_ric_alloc ) 
    … …  
    8989      !! References : Pacanowski & Philander 1981, JPO, 1441-1451. 
    9090      !!---------------------------------------------------------------------- 
    91       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    92       USE wrk_nemo, ONLY: zwx => wrk_2d_1 
     91      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     92      USE wrk_nemo, ONLY:   zwx => wrk_2d_1     ! 2D workspace 
    9393      !! 
    9494      INTEGER, INTENT( in ) ::   kt         ! ocean time-step indexocean time step 
    … …  
    100100      IF( wrk_in_use(2, 1) ) THEN 
    101101         CALL ctl_stop('zdf_ric : requested workspace array unavailable')   ;   RETURN 
    102       END IF 
     102      ENDIF 
    103103      !                                                ! =============== 
    104104      DO jk = 2, jpkm1                                 ! Horizontal slab 
    … …  
    121121         CALL lbc_lnk( zwx, 'W', 1. )                       ! Boundary condition   (sign unchanged) 
    122122 
    123  
    124123         ! Vertical eddy viscosity and diffusivity coefficients 
    125124         ! ------------------------------------------------------- 
    126          z05alp = 0.5 * rn_alp 
     125         z05alp = 0.5_wp * rn_alp 
    127126         DO jj = 1, jpjm1                                   ! Eddy viscosity coefficients (avm) 
    128127            DO ji = 1, jpim1 
    129                avmu(ji,jj,jk) = umask(ji,jj,jk)   & 
    130                   &           * rn_avmri / ( 1. + z05alp*( zwx(ji+1,jj)+zwx(ji,jj) ) )**nn_ric 
    131                avmv(ji,jj,jk) = vmask(ji,jj,jk)   & 
    132                   &           * rn_avmri / ( 1. + z05alp*( zwx(ji,jj+1)+zwx(ji,jj) ) )**nn_ric 
     128               avmu(ji,jj,jk) = umask(ji,jj,jk) * rn_avmri / ( 1. + z05alp*( zwx(ji+1,jj)+zwx(ji,jj) ) )**nn_ric 
     129               avmv(ji,jj,jk) = vmask(ji,jj,jk) * rn_avmri / ( 1. + z05alp*( zwx(ji,jj+1)+zwx(ji,jj) ) )**nn_ric 
    133130            END DO 
    134131         END DO 
    135132         DO jj = 2, jpjm1                                   ! Eddy diffusivity coefficients (avt) 
    136133            DO ji = 2, jpim1 
    137                avt(ji,jj,jk) = tmric(ji,jj,jk) / ( 1. + rn_alp * zwx(ji,jj) )   & 
    138                   &          * (  avmu(ji,jj,jk) + avmu(ji-1, jj ,jk)        & 
    139                   &             + avmv(ji,jj,jk) + avmv( ji ,jj-1,jk)  )     & 
     134               avt(ji,jj,jk) = tmric(ji,jj,jk) / ( 1._wp + rn_alp * zwx(ji,jj) )           & 
     135                  &                            * (  avmu(ji,jj,jk) + avmu(ji-1,jj,jk)      & 
     136                  &                               + avmv(ji,jj,jk) + avmv(ji,jj-1,jk)  )   & 
    140137                  &          + avtb(jk) * tmask(ji,jj,jk) 
    141138               !                                            ! Add the background coefficient on eddy viscosity 
    … …  
    151148      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. ) 
    152149      ! 
    153       IF( wrk_not_released(2, 1) )   CALL ctl_stop('zdf_ric : failed to release workspace array') 
     150      IF( wrk_not_released(2, 1) )   CALL ctl_stop('zdf_ric: failed to release workspace array') 
    154151      ! 
    155152   END SUBROUTINE zdf_ric 
    … …  
    169166      !! ** Action  :   increase by 1 the nstop flag is setting problem encounter 
    170167      !!---------------------------------------------------------------------- 
    171       INTEGER :: ji, jj, jk        ! dummy loop indices 
     168      INTEGER :: ji, jj, jk   ! dummy loop indices 
    172169      !! 
    173170      NAMELIST/namzdf_ric/ rn_avmri, rn_alp, nn_ric 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r2636 r2690  
    5858   PUBLIC   tke_rst        ! routine called in step module 
    5959 
    60    LOGICAL , PUBLIC, PARAMETER              ::   lk_zdftke = .TRUE.  !: TKE vertical mixing flag 
     60   LOGICAL , PUBLIC, PARAMETER ::   lk_zdftke = .TRUE.  !: TKE vertical mixing flag 
    6161 
    6262   !                                      !!** Namelist  namzdf_tke  ** 
    … …  
    8383 
    8484   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en             !: now turbulent kinetic energy   [m2/s2] 
     85   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau) 
     86   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation 
    8587#if defined key_c1d 
    8688   !                                                                        !!** 1D cfg only  **   ('key_c1d') 
    … …  
    8890   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_pdl, e_ric   !: prandl and local Richardson numbers 
    8991#endif 
    90    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau) 
    91    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation 
    9292 
    9393   !! * Substitutions 
    … …  
    110110         &      e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) ,                          & 
    111111#endif 
    112          &      en   (jpi,jpj,jpk) , htau (jpi,jpj)     , dissl(jpi,jpj,jpk) , STAT=zdf_tke_alloc ) 
     112         &      en   (jpi,jpj,jpk) , htau (jpi,jpj)     , dissl(jpi,jpj,jpk) , STAT= zdf_tke_alloc ) 
    113113         ! 
    114114      IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc ) 
    … …  
    191191      !! --------------------------------------------------------------------- 
    192192      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
    193       USE oce     , ONLY:   zdiag => ua , zd_up => va , zd_lw => ta   ! (ua,va,ta) used  as workspace 
     193      USE oce     , ONLY:   zdiag => ua , zd_up => va , zd_lw => ta   ! (ua,va,ta) used as workspace 
    194194      USE wrk_nemo, ONLY:   imlc  => iwrk_2d_1   ! 2D INTEGER workspace 
    195195      USE wrk_nemo, ONLY:   zhlc  =>  wrk_2d_1   ! 2D REAL workspace 
    196196      USE wrk_nemo, ONLY:   zpelc =>  wrk_3d_1   ! 3D REAL workspace 
    197       !! 
     197      ! 
    198198      INTEGER  ::   ji, jj, jk                      ! dummy loop arguments 
    199199!!bfr      INTEGER  ::   ikbu, ikbv, ikbum1, ikbvm1      ! temporary scalar 
    … …  
    210210      !!-------------------------------------------------------------------- 
    211211      ! 
    212       IF( iwrk_in_use(2, 1) .OR. & 
    213            wrk_in_use(2, 1) .OR. & 
    214            wrk_in_use(3, 1)   )THEN 
    215          CALL ctl_stop('tke_tke : requested workspace arrays unavailable.')   ;   RETURN 
     212      IF( iwrk_in_use(2, 1) .OR.   & 
     213           wrk_in_use(2, 1) .OR.   & 
     214           wrk_in_use(3, 1)   ) THEN 
     215         CALL ctl_stop('tke_tke: requested workspace arrays unavailable')   ;   RETURN 
    216216      END IF 
    217217 
    … …  
    431431      IF( iwrk_not_released(2 ,1) .OR.   & 
    432432           wrk_not_released(2, 1) .OR.   & 
    433            wrk_not_released(3, 1)  )   CALL ctl_stop( 'tke_tke : failed to release workspace arrays' ) 
     433           wrk_not_released(3, 1)  )   CALL ctl_stop( 'tke_tke: failed to release workspace arrays' ) 
    434434      ! 
    435435   END SUBROUTINE tke_tke 
    … …  
    471471      !!              - avmu, avmv : now vertical eddy viscosity at uw- and vw-points 
    472472      !!---------------------------------------------------------------------- 
    473       USE oce,     zmpdl  =>   ua   ! use ua as workspace 
    474       USE oce,     zmxlm  =>   va   ! use va as workspace 
    475       USE oce,     zmxld  =>   ta   ! use ta as workspace 
    476       !! 
    477       INTEGER  ::   ji, jj, jk            ! dummy loop arguments 
    478       REAL(wp) ::   zrn2, zraug           ! temporary scalars 
    479       REAL(wp) ::   zdku                  !    -         - 
    480       REAL(wp) ::   zdkv                  !    -         - 
    481       REAL(wp) ::   zcoef, zav            !    -         - 
    482       REAL(wp) ::   zpdlr, zri, zsqen     !    -         - 
    483       REAL(wp) ::   zemxl, zemlm, zemlp   !    -         - 
     473      USE oce, ONLY:   zmpdl => ua , zmxlm => va , zmxld => ta   ! (ua,va,ta) used as workspace 
     474      !! 
     475      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     476      REAL(wp) ::   zrn2, zraug, zcoef, zav     ! local scalars 
     477      REAL(wp) ::   zdku, zpdlr, zri, zsqen     !   -      - 
     478      REAL(wp) ::   zdkv, zemxl, zemlm, zemlp   !   -      - 
    484479      !!-------------------------------------------------------------------- 
    485480 
    … …  
    509504         END DO 
    510505      END DO 
    511       ! 
    512506      ! 
    513507      !                     !* Physical limits for the mixing length 
    … …  
    680674         &                 nn_etau , nn_htau  , rn_efr    
    681675      !!---------------------------------------------------------------------- 
    682  
     676      ! 
    683677      REWIND ( numnam )               !* Read Namelist namzdf_tke : Turbulente Kinetic Energy 
    684678      READ   ( numnam, namzdf_tke ) 
    685        
     679      ! 
    686680      ri_cri   = 2._wp    / ( 2._wp + rn_ediss / rn_ediff )   ! resulting critical Richardson number 
    687681      rmxl_min = 1.e-6_wp / ( rn_ediff * SQRT( rn_emin ) )    ! resulting minimum length to recover molecular viscosity 
    688  
     682      ! 
    689683      IF(lwp) THEN                    !* Control print 
    690684         WRITE(numout,*) 
    … …  
    710704         WRITE(numout,*) '      critical Richardson nb with your parameters  ri_cri = ', ri_cri 
    711705      ENDIF 
    712  
     706      ! 
    713707      !                              ! allocate tke arrays 
    714708      IF( zdf_tke_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_tke_init : unable to allocate arrays' ) 
    715  
     709      ! 
    716710      !                               !* Check of some namelist values 
    717711      IF( nn_mxl  < 0  .OR.  nn_mxl  > 3 )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1 or 2 ' ) 
    … …  
    738732         END SELECT 
    739733      ENDIF 
    740  
    741734      !                               !* set vertical eddy coef. to the background value 
    742735      DO jk = 1, jpk 
    … …  
    747740      END DO 
    748741      dissl(:,:,:) = 1.e-12_wp 
    749       !                               !* read or initialize all required files  
    750       CALL tke_rst( nit000, 'READ' ) 
     742      !                               
     743      CALL tke_rst( nit000, 'READ' )  !* read or initialize all required files 
    751744      ! 
    752745   END SUBROUTINE zdf_tke_init 
    … …  
    763756     !!                set to rn_emin or recomputed  
    764757     !!---------------------------------------------------------------------- 
    765      INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
    766      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
     758     INTEGER         , INTENT(in) ::   kt     ! ocean time-step 
     759     CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
    767760     ! 
    768761     INTEGER ::   jit, jk   ! dummy loop indices 
    769      INTEGER ::   id1, id2, id3, id4, id5, id6 
     762     INTEGER ::   id1, id2, id3, id4, id5, id6   ! local integers 
    770763     !!---------------------------------------------------------------------- 
    771764     ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r2676 r2690  
    234234         IF( Agrif_Root() ) CALL nemo_partition(mppsize) 
    235235#else 
    236          jpni = 1 
    237          jpnj = 1 
     236         jpni  = 1 
     237         jpnj  = 1 
    238238         jpnij = jpni*jpnj 
    239239#endif 
    … …  
    244244      ! than variables 
    245245      IF( Agrif_Root() ) THEN 
    246          jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci !: first  dim. 
    247          jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj !: second dim. 
    248          jpk = jpkdta                                           !: third dim 
    249          jpim1 = jpi-1                                          !: inner domain indices 
    250          jpjm1 = jpj-1                                          !:   "           " 
    251          jpkm1 = jpk-1                                          !:   "           " 
    252          jpij  = jpi*jpj                                        !:  jpi x j 
     246         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim. 
     247         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
     248         jpk = jpkdta                                             ! third dim 
     249         jpim1 = jpi-1                                            ! inner domain indices 
     250         jpjm1 = jpj-1                                            !   "           " 
     251         jpkm1 = jpk-1                                            !   "           " 
     252         jpij  = jpi*jpj                                          !  jpi x j 
    253253      ENDIF 
    254254 
    … …  
    469469 
    470470   SUBROUTINE nemo_alloc 
    471      !!---------------------------------------------------------------------- 
    472      !!                     ***  ROUTINE nemo_alloc  *** 
    473      !! 
    474      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules 
    475      !! 
    476      !! ** Method  : 
    477      !!---------------------------------------------------------------------- 
    478      USE diawri,       ONLY: dia_wri_alloc 
    479      USE dom_oce,      ONLY: dom_oce_alloc 
    480      USE ldfdyn_oce,   ONLY: ldfdyn_oce_alloc 
    481      USE ldftra_oce,   ONLY: ldftra_oce_alloc 
    482      USE trc_oce,      ONLY: trc_oce_alloc 
    483  
    484       USE wrk_nemo,    ONLY: wrk_alloc 
    485  
     471      !!---------------------------------------------------------------------- 
     472      !!                     ***  ROUTINE nemo_alloc  *** 
     473      !! 
     474      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules 
     475      !! 
     476      !! ** Method  : 
     477      !!---------------------------------------------------------------------- 
     478      USE diawri    , ONLY: dia_wri_alloc 
     479      USE dom_oce   , ONLY: dom_oce_alloc 
     480      USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc 
     481      USE ldftra_oce, ONLY: ldftra_oce_alloc 
     482      USE trc_oce   , ONLY: trc_oce_alloc 
     483      USE wrk_nemo  , ONLY: wrk_alloc 
     484      ! 
    486485      INTEGER :: ierr 
    487       INTEGER :: i 
    488       !!---------------------------------------------------------------------- 
    489  
     486      !!---------------------------------------------------------------------- 
     487      ! 
    490488      ierr =        oce_alloc       ()          ! ocean  
    491489      ierr = ierr + dia_wri_alloc   () 
    … …  
    497495      ierr = ierr + lib_mpp_alloc   (numout)    ! mpp exchanges 
    498496      ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays 
    499  
     497      ! 
    500498      ierr = ierr + wrk_alloc(numout, lwp)      ! workspace 
    501  
     499      ! 
    502500      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    503501      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' ) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

    r2636 r2690  
    6363      !!                  ***  trc_oce_alloc  *** 
    6464      !!---------------------------------------------------------------------- 
    65       ALLOCATE( etot3(jpi,jpj,jpk), Stat = trc_oce_alloc ) 
    66       ! 
    67       IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate array etot3') 
     65      ALLOCATE( etot3(jpi,jpj,jpk)   , STAT= trc_oce_alloc ) 
     66      ! 
     67      IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array') 
    6868   END FUNCTION trc_oce_alloc 
    6969 
    … …  
    250250      ! 
    251251      ! It is not necessary to compute anything bellow the following depth 
    252       zhext = prldex * ( LOG(10.e0) * zprec + LOG(pqsr_frc) ) 
    253       
     252      zhext = prldex * ( LOG(10._wp) * zprec + LOG(pqsr_frc) ) 
     253      ! 
    254254      ! Level of light extinction 
    255255      pjl = jpkm1 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90

    r2528 r2690  
    55   !!====================================================================== 
    66   !! History :   2.0  !  2008-12  (C. Ethe, G. Madec)  revised architecture 
    7    !!---------------------------------------------------------------------- 
    8    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    9    !! $Id$  
    10    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    117   !!---------------------------------------------------------------------- 
    128   USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER 
    … …  
    5551 
    5652   ! Starting/ending C14 do-loop indices (N.B. no C14 : jp_c14b0 > jp_c14b1 the do-loop are never done) 
    57    INTEGER, PUBLIC, PARAMETER ::   jp_c14b0     = jp_lb + 1                !: First index of C14 tracer 
    58    INTEGER, PUBLIC, PARAMETER ::   jp_c14b1     = jp_lb + jp_c14b          !: Last  index of C14 tracer 
     53   INTEGER, PUBLIC, PARAMETER ::   jp_c14b0     = jp_lb     + 1            !: First index of C14 tracer 
     54   INTEGER, PUBLIC, PARAMETER ::   jp_c14b1     = jp_lb     + jp_c14b      !: Last  index of C14 tracer 
    5955   INTEGER, PUBLIC, PARAMETER ::   jp_c14b0_2d  = jp_lb_2d  + 1            !: First index of C14 tracer 
    6056   INTEGER, PUBLIC, PARAMETER ::   jp_c14b1_2d  = jp_lb_2d  + jp_c14b_2d   !: Last  index of C14 tracer 
    … …  
    6460   INTEGER, PUBLIC, PARAMETER ::   jp_c14b1_trd = jp_lb_trd + jp_c14b_trd  !: Last  index of C14 tracer 
    6561 
     62   !!---------------------------------------------------------------------- 
     63   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     64   !! $Id$  
     65   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6666   !!====================================================================== 
    6767END MODULE par_c14b 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90

    r2643 r2690  
    44   !! TOP :   initialisation of the C14 bomb tracer 
    55   !!====================================================================== 
    6    !! History : Original ! 2005-10  (Z. Lachkar)  
    7    !!               2.0  ! 2007-12  (C. Ethe )  
     6   !! History :  1.0  ! 2005-10  (Z. Lachkar) Original code 
     7   !!            2.0  ! 2007-12  (C. Ethe)  
    88   !!---------------------------------------------------------------------- 
    99#if defined key_c14b 
    … …  
    2323   PUBLIC   trc_ini_c14b   ! called by trcini.F90 module 
    2424 
    25    INTEGER  ::   &     ! With respect to data file !! 
    26      jpybeg = 1765 , & !: starting year for C14 
    27      jpyend = 2002     !: ending year for C14 
    28  
    29    INTEGER  ::   &    
    30       nrec   ,  & ! number of year in CO2 Concentrations file 
    31       nmaxrec  
    32  
    33    INTEGER  ::   inum1, inum2               ! unit number 
    34  
    35    REAL(wp) ::     & 
    36      ys40 = -40. ,    &             ! 40 degrees south 
    37      ys20 = -20. ,    &             ! 20 degrees south 
    38      yn20 =  20. ,    &             ! 20 degrees north 
    39      yn40 =  40.                    ! 40 degrees north 
    40  
    41    !!--------------------------------------------------------------------- 
     25   !                             ! With respect to data file !! 
     26   INTEGER  ::   jpybeg = 1765   ! starting year for C14 
     27   INTEGER  ::   jpyend = 2002   ! ending year for C14 
     28   INTEGER  ::   nrec            ! number of year in CO2 Concentrations file 
     29   INTEGER  ::   nmaxrec  
     30   INTEGER  ::   inum1, inum2    ! unit number 
     31 
     32   REAL(wp) ::   ys40 = -40.     ! 40 degrees south 
     33   REAL(wp) ::   ys20 = -20.     ! 20 degrees south 
     34   REAL(wp) ::   yn20 =  20.     ! 20 degrees north 
     35   REAL(wp) ::   yn40 =  40.     ! 40 degrees north 
     36 
     37   !!---------------------------------------------------------------------- 
    4238   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4339   !! $Id$  
    44    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    45    !!---------------------------------------------------------------------- 
    46  
     40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     41   !!---------------------------------------------------------------------- 
    4742CONTAINS 
    4843 
    … …  
    5853      !!---------------------------------------------------------------------- 
    5954 
    60       CALL c14b_alloc()       ! Allocate CFC arrays 
     55      !                     ! Allocate C14b arrays 
     56      IF( trc_sms_c14b_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_c14b : unable to allocate C14b arrays' ) 
    6157 
    6258      CALL trc_ctl_c14b     !  Control consitency 
    … …  
    6965      ! Initialization of boundaries conditions 
    7066      ! ---------------------------------------  
    71       qtr_c14(:,:) = 0.e0 
     67      qtr_c14(:,:) = 0._wp 
    7268       
    7369      ! Initialization of qint in case of  no restart  
    … …  
    7874            WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero ' 
    7975         ENDIF 
    80          trn     (:,:,:,jpc14) = 0.e0 
    81          qint_c14(:,:        ) = 0.e0 
     76         trn     (:,:,:,jpc14) = 0._wp 
     77         qint_c14(:,:        ) = 0._wp 
    8278      ENDIF 
    8379 
    … …  
    156152                 fareaz(ji,jj,3) = 0. 
    157153            ENDIF 
    158           END DO 
    159         END DO 
    160  
     154         END DO 
     155      END DO 
    161156      ! 
    162157      IF(lwp) WRITE(numout,*) 'Initialization of C14 bomb tracer done' 
    163158      IF(lwp) WRITE(numout,*) ' ' 
    164  
     159      ! 
    165160   END SUBROUTINE trc_ini_c14b 
    166161 
    167    SUBROUTINE c14b_alloc 
    168       !!---------------------------------------------------------------------- 
    169       !!                     ***  ROUTINE c14b_alloc  *** 
    170       !! 
    171       !! ** Purpose :   Allocate all the dynamic arrays of C14b 
    172       !!---------------------------------------------------------------------- 
    173  
    174       !                                ! Allocate C14b arrays 
    175       IF( trc_sms_c14b_alloc() /= 0 )   & 
    176          &         CALL ctl_stop( 'STOP', 'trc_ini_c14b : unable to allocate C14b arrays' ) 
    177       ! 
    178    END SUBROUTINE c14b_alloc 
    179     
     162 
    180163   SUBROUTINE trc_ctl_c14b 
    181164      !!---------------------------------------------------------------------- 
    … …  
    192175      ! Check number of tracers 
    193176      ! -----------------------    
    194       IF( jp_c14b > 1) CALL ctl_stop( ' Change jp_c14b to be equal 1 in par_c14b.F90' ) 
     177      IF( jp_c14b > 1)   CALL ctl_stop( ' Change jp_c14b to be equal 1 in par_c14b.F90' ) 
    195178 
    196179      ! Check tracer names 
    197180      ! ------------------ 
    198       IF ( ctrcnm(jpc14) /= 'C14B' ) THEN 
    199            ctrcnm(jpc14)  = 'C14B' 
    200            ctrcnl(jpc14)  = 'Bomb C14 concentration' 
     181      IF( ctrcnm(jpc14) /= 'C14B' ) THEN 
     182          ctrcnm(jpc14)  = 'C14B' 
     183          ctrcnl(jpc14)  = 'Bomb C14 concentration' 
    201184      ENDIF 
    202185 
    … …  
    210193      ! ------------------ 
    211194      IF( ctrcun(jpc14) /= 'ration' ) THEN 
    212           ctrcun(jpc14) = 'ration' 
     195          ctrcun(jpc14)  = 'ration' 
    213196          IF(lwp) THEN 
    214197             CALL ctl_warn( ' we force tracer unit' ) 
    … …  
    219202      ! 
    220203   END SUBROUTINE trc_ctl_c14b 
     204    
    221205#else 
    222206   !!---------------------------------------------------------------------- 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r2643 r2690  
    1313   !!   'key_c14b'                                         Bomb C14 tracer 
    1414   !!---------------------------------------------------------------------- 
    15    !!   trc_sms_c14b  :  compute and add C14 suface forcing to C14 trends 
    16    !!---------------------------------------------------------------------- 
    17    USE oce_trc      ! Ocean variables 
    18    USE par_trc      ! TOP parameters 
    19    USE trc          ! TOP variables 
     15   !!   trc_sms_c14b :  compute and add C14 suface forcing to C14 trends 
     16   !!---------------------------------------------------------------------- 
     17   USE oce_trc       ! Ocean variables 
     18   USE par_trc       ! TOP parameters 
     19   USE trc           ! TOP variables 
    2020   USE trdmod_oce 
    2121   USE trdmod_trc 
    22    USE iom 
     22   USE iom           ! I/O library 
    2323 
    2424   IMPLICIT NONE 
    2525   PRIVATE 
    2626 
    27    !! * Routine accessibility 
    2827   PUBLIC   trc_sms_c14b       ! called in trcsms.F90 
    29    PUBLIC   trc_sms_c14b_alloc ! called in nemogcm.F90 
    30  
    31    !! * Module variables 
     28   PUBLIC   trc_sms_c14b_alloc ! called in trcini_c14b.F90 
     29 
    3230   INTEGER , PUBLIC, PARAMETER ::   jpmaxrec  = 240           ! temporal parameter  
    3331   INTEGER , PUBLIC, PARAMETER ::   jpmaxrec2 = 2 * jpmaxrec  !  
    … …  
    3937   INTEGER , PUBLIC    ::   nyear_beg        ! initial year (aa)  
    4038 
    41    REAL(wp), PUBLIC,           DIMENSION(jpmaxrec,jpzon)  ::  bomb   !: C14 atm data (3 zones) 
    42    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::  fareaz !: Spatial Interpolation Factors 
    43    REAL(wp), PUBLIC,                DIMENSION(jpmaxrec2)  ::  spco2  !: Atmospheric CO2 
     39   REAL(wp), PUBLIC,                    DIMENSION(jpmaxrec,jpzon) ::   bomb       !: C14 atm data (3 zones) 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)          ::   fareaz    !: Spatial Interpolation Factors 
     41   REAL(wp), PUBLIC,                    DIMENSION(jpmaxrec2)      ::   spco2      !: Atmospheric CO2 
    4442   
    45    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::   qtr_c14      !: flux at surface 
    46    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::   qint_c14     !: cumulative flux 
    47  
    48    REAL(wp) :: xlambda, xdecay, xaccum       ! C14 decay coef.   
    49  
    50    REAL(wp) ::   xconv1 = 1.0          ! conversion from to  
    51    REAL(wp) ::   xconv2 = 0.01/3600.   ! conversion from cm/h to m/s:  
    52    REAL(wp) ::   xconv3 = 1.0e+3       ! conversion from mol/l/atm to mol/m3/atm 
    53  
    54   !! * Substitutions 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)            ::   qtr_c14    !: flux at surface 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)            ::   qint_c14   !: cumulative flux 
     45 
     46   REAL(wp) ::   xlambda, xdecay, xaccum       ! C14 decay coef.   
     47   REAL(wp) ::   xconv1 = 1._wp                ! conversion from to  
     48   REAL(wp) ::   xconv2 = 0.01_wp / 3600._wp   ! conversion from cm/h to m/s:  
     49   REAL(wp) ::   xconv3 = 1.e+3_wp             ! conversion from mol/l/atm to mol/m3/atm 
     50 
     51   !! * Substitutions 
    5552#  include "top_substitute.h90" 
    5653 
    57   !!---------------------------------------------------------------------- 
    58   !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    59   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp $  
    60   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    61   !!---------------------------------------------------------------------- 
    62  
     54   !!---------------------------------------------------------------------- 
     55   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     56   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp $  
     57   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     58   !!---------------------------------------------------------------------- 
    6359CONTAINS 
    6460 
    65  
    66   SUBROUTINE trc_sms_c14b( kt ) 
    67      !!---------------------------------------------------------------------- 
    68      !!                  ***  ROUTINE trc_sms_c14b  *** 
    69      !! 
    70      !! ** Purpose :   Compute the surface boundary contition on C14bomb 
    71      !!      passive tracer associated with air-mer fluxes and add it to  
    72      !!      the general trend of tracers equations. 
    73      !! 
    74      !! ** Original comments from J. Orr : 
    75      !! 
    76      !!      Calculates the input of Bomb C-14 to the surface layer of OPA 
    77      !! 
    78      !!      James Orr, LMCE, 28 October 1992 
    79      !! 
    80      !!      Initial approach mimics that of Toggweiler, Dixon, & Bryan (1989) 
    81      !!      (hereafter referred to as TDB) with constant gas exchange, 
    82      !!      although in this case, a perturbation approach is used for 
    83      !!      bomb-C14 so that both the ocean and atmosphere begin at zero. 
    84      !!      This saves tremendous amounts of computer time since no 
    85      !!      equilibrum run is first required (i.e., for natural C-14). 
    86      !!      Note: Many sensitivity tests can be run with this approach and 
    87      !!            one never has to make a run for natural C-14; otherwise, 
    88      !!            a run for natural C-14 must be run each time that one 
    89      !!            changes a model parameter! 
    90      !! 
    91      !! 
    92      !!      19 August 1993: Modified to consider Atmospheric C-14 fom IPCC. 
    93      !!      That is, the IPCC has provided a C-14 atmospheric record (courtesy 
    94      !!      of Martin Heimann) for model calibration.  This model spans from 
    95      !!      preindustrial times to present, in a format different than that 
    96      !!      given by TDB.  It must be converted to the ORR C-14 units used 
    97      !!      here, although in this case, the perturbation includes not only 
    98      !!      bomb C-14 but changes due to the Suess effect. 
    99      !! 
    100      !!---------------------------------------------------------------------- 
    101      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    102      USE wrk_nemo, ONLY: zatmbc14 => wrk_2d_1 
    103      USE wrk_nemo, ONLY:     zw3d => wrk_3d_1 
    104      !! * Arguments 
    105      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
    106  
    107      !! * Local declarations 
    108      INTEGER :: ji, jj, jk, jz     ! dummy loop indices  
    109  
    110      INTEGER :: iyear_beg, iyear_beg1, iyear_end1  
    111      INTEGER :: iyear_beg2, iyear_end2  
    112      INTEGER :: imonth1, im1, in1  
    113      INTEGER :: imonth2, im2, in2  
    114           
    115      REAL(wp), DIMENSION(jpzon) :: zonbc14       !: time interp atm C14  
    116      REAL(wp)                   :: zpco2at       !: time interp atm C02  
    117  
    118      REAL(wp) :: zt, ztp, zsk      !: dummy variables 
    119      REAL(wp) :: zsol              !: solubility 
    120      REAL(wp) :: zsch              !: schmidt number 
    121      REAL(wp) :: zv2               !: wind speed ( square) 
    122      REAL(wp) :: zpv               !: piston velocity  
    123      REAL(wp) :: zdemi, ztra 
    124       !!---------------------------------------------------------------------- 
    125  
    126       IF( ( wrk_in_use(2, 1) ) .OR. ( wrk_in_use(3, 1) ) ) THEN 
    127          CALL ctl_stop('trc_sms_c14b : requested workspace arrays unavailable.') 
    128          RETURN 
    129       END IF 
    130  
    131       IF( kt == nit000 )  THEN 
    132          ! Computation of decay coeffcient 
    133          zdemi   = 5730. 
     61   SUBROUTINE trc_sms_c14b( kt ) 
     62      !!---------------------------------------------------------------------- 
     63      !!                  ***  ROUTINE trc_sms_c14b  *** 
     64      !! 
     65      !! ** Purpose :   Compute the surface boundary contition on C14bomb 
     66      !!      passive tracer associated with air-mer fluxes and add it to  
     67      !!      the general trend of tracers equations. 
     68      !! 
     69      !! ** Original comments from J. Orr : 
     70      !! 
     71      !!      Calculates the input of Bomb C-14 to the surface layer of OPA 
     72      !! 
     73      !!      James Orr, LMCE, 28 October 1992 
     74      !! 
     75      !!      Initial approach mimics that of Toggweiler, Dixon, & Bryan (1989) 
     76      !!      (hereafter referred to as TDB) with constant gas exchange, 
     77      !!      although in this case, a perturbation approach is used for 
     78      !!      bomb-C14 so that both the ocean and atmosphere begin at zero. 
     79      !!      This saves tremendous amounts of computer time since no 
     80      !!      equilibrum run is first required (i.e., for natural C-14). 
     81      !!      Note: Many sensitivity tests can be run with this approach and 
     82      !!            one never has to make a run for natural C-14; otherwise, 
     83      !!            a run for natural C-14 must be run each time that one 
     84      !!            changes a model parameter! 
     85      !! 
     86      !! 
     87      !!      19 August 1993: Modified to consider Atmospheric C-14 fom IPCC. 
     88      !!      That is, the IPCC has provided a C-14 atmospheric record (courtesy 
     89      !!      of Martin Heimann) for model calibration.  This model spans from 
     90      !!      preindustrial times to present, in a format different than that 
     91      !!      given by TDB.  It must be converted to the ORR C-14 units used 
     92      !!      here, although in this case, the perturbation includes not only 
     93      !!      bomb C-14 but changes due to the Suess effect. 
     94      !! 
     95      !!---------------------------------------------------------------------- 
     96      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     97      USE wrk_nemo, ONLY:   zatmbc14 => wrk_2d_1 
     98      USE wrk_nemo, ONLY:   zw3d     => wrk_3d_1 
     99      ! 
     100      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     101      ! 
     102      INTEGER :: ji, jj, jk, jz     ! dummy loop indices  
     103      INTEGER :: iyear_beg , iyear_beg1, iyear_end1  
     104      INTEGER :: iyear_beg2, iyear_end2  
     105      INTEGER :: imonth1, im1, in1  
     106      INTEGER :: imonth2, im2, in2  
     107      REAL(wp), DIMENSION(jpzon) :: zonbc14       !: time interp atm C14  
     108      REAL(wp)                   :: zpco2at       !: time interp atm C02  
     109      REAL(wp) :: zt, ztp, zsk      ! dummy variables 
     110      REAL(wp) :: zsol              ! solubility 
     111      REAL(wp) :: zsch              ! schmidt number 
     112      REAL(wp) :: zv2               ! wind speed ( square) 
     113      REAL(wp) :: zpv               ! piston velocity  
     114      REAL(wp) :: zdemi, ztra 
     115      !!---------------------------------------------------------------------- 
     116 
     117      IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1) ) THEN 
     118         CALL ctl_stop('trc_sms_c14b : requested workspace arrays unavailable')   ;   RETURN 
     119      ENDIF 
     120 
     121      IF( kt == nit000 )  THEN         ! Computation of decay coeffcient 
     122         zdemi   = 5730._wp 
    134123         xlambda = LOG(2.) / zdemi / ( nyear_len(1) * rday ) 
    135124         xdecay  = EXP( - xlambda * rdt ) 
    136          xaccum  = 1.0 -  xdecay 
     125         xaccum  = 1._wp -  xdecay 
    137126      ENDIF 
    138127 
    … …  
    204193      !  (zonmean), computes area-weighted mean to give the atmospheric C-14 
    205194      !  ---------------------------------------------------------------- 
    206       DO jj = 1, jpj 
    207          DO ji = 1, jpi 
    208             zatmbc14(ji,jj) =   zonbc14(1) * fareaz(ji,jj,1)  & 
    209                  &           +  zonbc14(2) * fareaz(ji,jj,2)  & 
    210                  &           +  zonbc14(3) * fareaz(ji,jj,3) 
    211          END DO 
    212       END DO 
     195      zatmbc14(:,:) = zonbc14(1) * fareaz(:,:,1)   & 
     196         &          + zonbc14(2) * fareaz(:,:,2)   & 
     197         &          + zonbc14(3) * fareaz(:,:,3) 
    213198       
    214199      ! time interpolation of CO2 concentrations to it time step   
    … …  
    216201           &     + spco2(iyear_end2) * FLOAT( in2 ) ) / 6. 
    217202 
    218       IF (lwp) THEN 
     203      IF(lwp) THEN 
    219204          WRITE(numout, *) 'time : ', kt, ' CO2 year begin/end :',iyear_beg2,'/',iyear_end2,   & 
    220205          &                ' CO2 concen : ',zpco2at  
    … …  
    236221               zsol = EXP( -60.2409 + 93.4517 / ztp  + 23.3585 * LOG( ztp ) + zsk * tsn(ji,jj,1,jp_sal) ) 
    237222               ! convert solubilities [mol/(l * atm)] -> [mol/(m^3 * ppm)] 
    238                zsol = zsol * 1.0e-03 
     223               zsol = zsol * 1.e-03 
    239224            ELSE 
    240                zsol = 0. 
     225               zsol = 0._wp 
    241226            ENDIF 
    242227 
    … …  
    305290      CALL iom_put( "fdecay" , zw3d ) 
    306291#endif 
    307       IF( l_trdtrc ) THEN 
    308          CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt )   ! save trends 
    309       END IF 
    310  
    311       IF( ( wrk_not_released(2, 1)) .OR. ( wrk_not_released(3, 1) ) )   & 
    312       &   CALL ctl_stop('trc_sms_c14b : failed to release workspace arrays.') 
    313  
    314     END SUBROUTINE trc_sms_c14b 
    315  
    316   INTEGER FUNCTION trc_sms_c14b_alloc() 
    317      !!---------------------------------------------------------------------- 
    318      !!                  ***  ROUTINE trc_sms_c14b_alloc  *** 
    319      !!---------------------------------------------------------------------- 
    320  
    321      ALLOCATE( fareaz(jpi,jpj ,jpzon),     & 
    322        &       qtr_c14(jpi,jpj)      ,     & 
    323        &       qint_c14(jpi,jpj)     , STAT=trc_sms_c14b_alloc ) 
    324  
    325      IF( trc_sms_c14b_alloc /= 0 ) CALL ctl_warn('trc_sms_c14b_alloc : failed to allocate arrays.') 
    326  
    327   END FUNCTION trc_sms_c14b_alloc 
     292      IF( l_trdtrc )   CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt )   ! save trends 
     293 
     294      IF( wrk_not_released(2, 1) .OR.   & 
     295          wrk_not_released(3, 1) )   CALL ctl_stop('trc_sms_c14b : failed to release workspace arrays') 
     296      ! 
     297   END SUBROUTINE trc_sms_c14b 
     298 
     299 
     300   INTEGER FUNCTION trc_sms_c14b_alloc() 
     301      !!---------------------------------------------------------------------- 
     302      !!                  ***  ROUTINE trc_sms_c14b_alloc  *** 
     303      !!---------------------------------------------------------------------- 
     304      ALLOCATE( fareaz  (jpi,jpj ,jpzon) ,     & 
     305         &      qtr_c14 (jpi,jpj)        ,     & 
     306         &      qint_c14(jpi,jpj)        , STAT=trc_sms_c14b_alloc ) 
     307         ! 
     308      IF( trc_sms_c14b_alloc /= 0 )   CALL ctl_warn('trc_sms_c14b_alloc: failed to allocate arrays') 
     309      ! 
     310   END FUNCTION trc_sms_c14b_alloc 
     311 
    328312#else 
    329     !!---------------------------------------------------------------------- 
    330     !!   Default option                                         Dummy module 
    331     !!---------------------------------------------------------------------- 
     313   !!---------------------------------------------------------------------- 
     314   !!   Default option                                         Dummy module 
     315   !!---------------------------------------------------------------------- 
    332316CONTAINS 
    333   SUBROUTINE trc_sms_c14b( kt )       ! Empty routine 
    334     WRITE(*,*) 'trc_freons: You should not have seen this print! error?', kt 
    335   END SUBROUTINE trc_sms_c14b 
     317   SUBROUTINE trc_sms_c14b( kt )       ! Empty routine 
     318      WRITE(*,*) 'trc_freons: You should not have seen this print! error?', kt 
     319   END SUBROUTINE trc_sms_c14b 
    336320#endif 
    337321 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90

    r2643 r2690  
    3333   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3434   !!---------------------------------------------------------------------- 
    35  
    3635CONTAINS 
    3736 
    … …  
    4544      !!---------------------------------------------------------------------- 
    4645      INTEGER  ::  ji, jj, jn, jl, jm, js 
    47       REAL(wp) ::  zyy  , zyd 
     46      REAL(wp) ::  zyy, zyd 
    4847      !!---------------------------------------------------------------------- 
    4948 
    … …  
    5251      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 
    5352 
    54       CALL cfc_alloc()       ! Allocate CFC arrays 
     53      !                                ! Allocate CFC arrays 
     54      IF( trc_sms_cfc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_cfc: unable to allocate CFC arrays' ) 
    5555 
    5656 
    5757      ! Initialization of boundaries conditions 
    5858      ! ---------------------------------------  
    59       xphem (:,:)    = 0.e0 
    60       p_cfc(:,:,:)   = 0.e0 
     59      xphem (:,:)    = 0._wp 
     60      p_cfc(:,:,:)   = 0._wp 
    6161       
    6262      ! Initialization of qint in case of  no restart  
    6363      !---------------------------------------------- 
    64       qtr_cfc(:,:,:) = 0.e0 
     64      qtr_cfc(:,:,:) = 0._wp 
    6565      IF( .NOT. ln_rsttr ) THEN     
    6666         IF(lwp) THEN 
    … …  
    6868            WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero ' 
    6969         ENDIF 
    70          qint_cfc(:,:,:) = 0.e0 
     70         qint_cfc(:,:,:) = 0._wp 
    7171         DO jl = 1, jp_cfc 
    7272            jn = jp_cfc0 + jl - 1 
    73             trn     (:,:,:,jn) = 0.e0 
     73            trn(:,:,:,jn) = 0._wp 
    7474         END DO 
    7575      ENDIF 
    … …  
    117117         WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS ' 
    118118         DO jn = 30, 100 
    119             WRITE(numout, '( 1I4, 4F9.2)')   & 
    120                &         jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2) 
     119            WRITE(numout, '( 1I4, 4F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2) 
    121120         END DO 
    122121      ENDIF 
    … …  
    136135      END DO 
    137136      ! 
    138  
    139137      IF(lwp) WRITE(numout,*) 'Initialization of CFC tracers done' 
    140138      IF(lwp) WRITE(numout,*) ' ' 
    141  
     139      ! 
    142140   END SUBROUTINE trc_ini_cfc 
    143  
    144    SUBROUTINE cfc_alloc 
    145       !!---------------------------------------------------------------------- 
    146       !!                     ***  ROUTINE cfc_alloc  *** 
    147       !! 
    148       !! ** Purpose :   Allocate all the dynamic arrays of CFC 
    149       !!---------------------------------------------------------------------- 
    150  
    151       !                                ! Allocate CFC arrays 
    152       IF( trc_sms_cfc_alloc() /= 0 )   & 
    153          &           CALL ctl_stop( 'STOP', 'trc_ini_cfc : unable to allocate CFC arrays' ) 
    154       ! 
    155    END SUBROUTINE cfc_alloc 
    156141    
    157142#else 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r2643 r2690  
    44   !! TOP : CFC main model 
    55   !!====================================================================== 
    6    !! History :    -   !  1999-10  (JC. Dutay)  original code 
    7    !!             1.0  !  2004-03 (C. Ethe) free form + modularity 
    8    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation 
     6   !! History :  OPA  !  1999-10  (JC. Dutay)  original code 
     7   !!  NEMO      1.0  !  2004-03 (C. Ethe) free form + modularity 
     8   !!            2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation 
    99   !!---------------------------------------------------------------------- 
    1010#if defined key_cfc 
    … …  
    1212   !!   'key_cfc'                                               CFC tracers 
    1313   !!---------------------------------------------------------------------- 
    14    !!   trc_sms_cfc     :  compute and add CFC suface forcing to CFC trends 
    15    !!   trc_cfc_cst :  sets constants for CFC surface forcing computation 
    16    !!---------------------------------------------------------------------- 
    17    USE oce_trc      ! Ocean variables 
    18    USE par_trc      ! TOP parameters 
    19    USE trc          ! TOP variables 
     14   !!   trc_sms_cfc  :  compute and add CFC suface forcing to CFC trends 
     15   !!   trc_cfc_cst  :  sets constants for CFC surface forcing computation 
     16   !!---------------------------------------------------------------------- 
     17   USE oce_trc       ! Ocean variables 
     18   USE par_trc       ! TOP parameters 
     19   USE trc           ! TOP variables 
    2020   USE trdmod_oce 
    2121   USE trdmod_trc 
    22    USE iom 
     22   USE iom           ! I/O library 
    2323 
    2424   IMPLICIT NONE 
    … …  
    2626 
    2727   PUBLIC   trc_sms_cfc         ! called in ???     
    28    PUBLIC   trc_sms_cfc_alloc   ! called in nemogcm.F90 
     28   PUBLIC   trc_sms_cfc_alloc   ! called in trcini_cfc.F90 
    2929 
    3030   INTEGER , PUBLIC, PARAMETER ::   jpyear = 150   ! temporal parameter  
    … …  
    5555   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5656   !! $Id$  
    57    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    58    !!---------------------------------------------------------------------- 
    59  
     57   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     58   !!---------------------------------------------------------------------- 
    6059CONTAINS 
    61  
    6260 
    6361   SUBROUTINE trc_sms_cfc( kt ) 
    … …  
    7775      !!                CFC concentration in pico-mol/m3 
    7876      !!---------------------------------------------------------------------- 
    79       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    80       USE wrk_nemo, ONLY: ztrcfc => wrk_3d_1        ! use for CFC sms trend 
    81       !! 
    82       INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
    83       !! 
    84       INTEGER ::   ji, jj, jn, jl, jm, js 
    85       INTEGER ::   iyear_beg, iyear_end 
    86       INTEGER ::   im1, im2 
    87  
     77      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     78      USE wrk_nemo, ONLY:   ztrcfc => wrk_3d_1        ! use for CFC sms trend 
     79      ! 
     80      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     81      ! 
     82      INTEGER  ::   ji, jj, jn, jl, jm, js 
     83      INTEGER  ::   iyear_beg, iyear_end 
     84      INTEGER  ::   im1, im2 
    8885      REAL(wp) ::   ztap, zdtap         
    8986      REAL(wp) ::   zt1, zt2, zt3, zv2 
    … …  
    9390      REAL(wp) ::   zca_cfc   ! concentration at equilibrium 
    9491      REAL(wp) ::   zak_cfc   ! transfert coefficients 
    95  
    96       REAL(wp), DIMENSION(jphem,jp_cfc)   ::   zpatm       ! atmospheric function 
    97       !!---------------------------------------------------------------------- 
    98  
     92      REAL(wp), DIMENSION(jphem,jp_cfc) ::   zpatm   ! atmospheric function 
     93      !!---------------------------------------------------------------------- 
     94      ! 
    9995      IF( wrk_in_use(3, 1) ) THEN 
    100          CALL ctl_stop('trc_sms_cfc : requested workspace array unavailable.') 
    101          RETURN 
    102       END IF 
     96         CALL ctl_stop('trc_sms_cfc: requested workspace array unavailable')   ;   RETURN 
     97      ENDIF 
    10398 
    10499      IF( kt == nit000 )   CALL trc_cfc_cst 
    … …  
    199194          END DO 
    200195      END IF 
    201  
    202       IF( wrk_not_released(3, 1) ) CALL ctl_stop('trc_sms_cfc : failed to release workspace array.') 
    203  
     196      ! 
     197      IF( wrk_not_released(3, 1) )   CALL ctl_stop('trc_sms_cfc: failed to release workspace array') 
     198      ! 
    204199   END SUBROUTINE trc_sms_cfc 
     200 
    205201 
    206202   SUBROUTINE trc_cfc_cst 
    … …  
    211207      !!--------------------------------------------------------------------- 
    212208 
    213  
    214         ! coefficient for CFC11  
    215         !---------------------- 
    216  
    217         ! Solubility 
    218         soa(1,1) = -229.9261  
    219         soa(2,1) =  319.6552 
    220         soa(3,1) =  119.4471 
    221         soa(4,1) =  -1.39165 
    222  
    223         sob(1,1) =  -0.142382 
    224         sob(2,1) =   0.091459 
    225         sob(3,1) =  -0.0157274 
    226  
    227         ! Schmidt number  
    228         sca(1,1) = 3501.8 
    229         sca(2,1) = -210.31 
    230         sca(3,1) =  6.1851 
    231         sca(4,1) = -0.07513 
    232  
    233         ! coefficient for CFC12  
    234         !---------------------- 
    235  
    236         ! Solubility 
    237         soa(1,2) = -218.0971 
    238         soa(2,2) =  298.9702 
    239         soa(3,2) =  113.8049 
    240         soa(4,2) =  -1.39165 
    241  
    242         sob(1,2) =  -0.143566 
    243         sob(2,2) =   0.091015 
    244         sob(3,2) =  -0.0153924 
    245  
    246         ! schmidt number  
    247         sca(1,2) =  3845.4  
    248         sca(2,2) =  -228.95 
    249         sca(3,2) =  6.1908  
    250         sca(4,2) =  -0.067430 
     209      ! coefficient for CFC11  
     210      !---------------------- 
     211 
     212      ! Solubility 
     213      soa(1,1) = -229.9261  
     214      soa(2,1) =  319.6552 
     215      soa(3,1) =  119.4471 
     216      soa(4,1) =  -1.39165 
     217 
     218      sob(1,1) =  -0.142382 
     219      sob(2,1) =   0.091459 
     220      sob(3,1) =  -0.0157274 
     221 
     222      ! Schmidt number  
     223      sca(1,1) = 3501.8 
     224      sca(2,1) = -210.31 
     225      sca(3,1) =  6.1851 
     226      sca(4,1) = -0.07513 
     227 
     228      ! coefficient for CFC12  
     229      !---------------------- 
     230 
     231      ! Solubility 
     232      soa(1,2) = -218.0971 
     233      soa(2,2) =  298.9702 
     234      soa(3,2) =  113.8049 
     235      soa(4,2) =  -1.39165 
     236 
     237      sob(1,2) =  -0.143566 
     238      sob(2,2) =   0.091015 
     239      sob(3,2) =  -0.0153924 
     240 
     241      ! schmidt number  
     242      sca(1,2) =  3845.4  
     243      sca(2,2) =  -228.95 
     244      sca(3,2) =  6.1908  
     245      sca(4,2) =  -0.067430 
    251246 
    252247   END SUBROUTINE trc_cfc_cst 
    253     
     248 
     249 
    254250   INTEGER FUNCTION trc_sms_cfc_alloc() 
    255251      !!---------------------------------------------------------------------- 
    256252      !!                     ***  ROUTINE trc_sms_cfc_alloc  *** 
    257253      !!---------------------------------------------------------------------- 
    258  
    259       ALLOCATE( xphem(jpi,jpj)          ,    & 
    260          &      qtr_cfc(jpi,jpj,jp_cfc) ,    & 
    261          &      qint_cfc(jpi,jpj,jp_cfc),    & 
    262          &                               STAT=trc_sms_cfc_alloc ) 
    263  
     254      ALLOCATE( xphem   (jpi,jpj)        ,     & 
     255         &      qtr_cfc (jpi,jpj,jp_cfc) ,     & 
     256         &      qint_cfc(jpi,jpj,jp_cfc) , STAT=trc_sms_cfc_alloc ) 
     257         ! 
    264258      IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.') 
    265  
     259      ! 
    266260   END FUNCTION trc_sms_cfc_alloc 
    267261 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/LOBSTER/sms_lobster.F90

    r2643 r2690  
    44   !! TOP :   LOBSTER 1 Source Minus Sink variables 
    55   !!---------------------------------------------------------------------- 
    6    !! History :    -   !  1999-09 (M. Levy)  original code 
    7    !!              -   !  2000-12 (O. Aumont, E. Kestenare) add sediment  
    8    !!             1.0  !  2005-10 (C. Ethe) F90 
    9    !!             1.0  !  2005-03  (A-S Kremeur) add fphylab, fzoolab, fdetlab, fdbod 
    10    !!              -   !  2005-06  (A-S Kremeur) add sedpocb, sedpocn, sedpoca 
    11    !!             2.0  !  2007-04  (C. Deltel, G. Madec) Free form and modules 
     6   !! History :  OPA  !  1999-09 (M. Levy)  original code 
     7   !!             -   !  2000-12 (O. Aumont, E. Kestenare) add sediment  
     8   !!   NEMO     1.0  !  2005-10 (C. Ethe) F90 
     9   !!             -   !  2005-03  (A-S Kremeur) add fphylab, fzoolab, fdetlab, fdbod 
     10   !!             -   !  2005-06  (A-S Kremeur) add sedpocb, sedpocn, sedpoca 
     11   !!            2.0  !  2007-04  (C. Deltel, G. Madec) Free form and modules 
    1212   !!---------------------------------------------------------------------- 
    1313#if defined key_lobster 
    … …  
    1515   !!   'key_lobster'                                         LOBSTER model 
    1616   !!---------------------------------------------------------------------- 
    17    USE par_oce 
    18    USE par_trc 
     17   USE par_oce    ! ocean parameters 
     18   USE par_trc    ! passive tracer parameters 
     19   USE lib_mpp    ! MPP library 
    1920 
    2021   IMPLICIT NONE 
    2122   PUBLIC 
     23 
     24   PUBLIC   sms_lobster_alloc   ! called in trcini_lobster.F90 
    2225 
    2326   !!  biological parameters 
    … …  
    7376   !! Optical parameters                                 
    7477   !! ------------------                                 
    75    REAL(wp) ::   xkr0       !: water coefficient absorption in red      (NAMELIST) 
    76    REAL(wp) ::   xkg0       !: water coefficient absorption in green    (NAMELIST) 
    77    REAL(wp) ::   xkrp       !: pigment coefficient absorption in red    (NAMELIST) 
    78    REAL(wp) ::   xkgp       !: pigment coefficient absorption in green  (NAMELIST) 
    79    REAL(wp) ::   xlr        !: exposant for pigment absorption in red   (NAMELIST) 
    80    REAL(wp) ::   xlg        !: exposant for pigment absorption in green (NAMELIST) 
    81    REAL(wp) ::   rpig       !: chla/chla+phea ratio                     (NAMELIST) 
     78   REAL(wp) ::   xkr0     !: water coefficient absorption in red      (NAMELIST) 
     79   REAL(wp) ::   xkg0     !: water coefficient absorption in green    (NAMELIST) 
     80   REAL(wp) ::   xkrp     !: pigment coefficient absorption in red    (NAMELIST) 
     81   REAL(wp) ::   xkgp     !: pigment coefficient absorption in green  (NAMELIST) 
     82   REAL(wp) ::   xlr      !: exposant for pigment absorption in red   (NAMELIST) 
     83   REAL(wp) ::   xlg      !: exposant for pigment absorption in green (NAMELIST) 
     84   REAL(wp) ::   rpig     !: chla/chla+phea ratio                     (NAMELIST) 
    8285                                                         
    83    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)    ::   neln    !: number of levels in the euphotic layer 
    84    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    ::   xze     !: euphotic layer depth 
    85    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:,:) ::   xpar    !: par (photosynthetic available radiation) 
     86   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   neln   !: number of levels in the euphotic layer 
     87   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xze    !: euphotic layer depth 
     88   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xpar   !: par (photosynthetic available radiation) 
    8689 
    8790   !! Sediment parameters                                
    … …  
    9194   REAL(wp) ::   areacot      !: ??? 
    9295                                                         
    93    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:)   ::   dminl   !: fraction of sinking POC released in sediments 
    94    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:,:) ::   dmin3   !: fraction of sinking POC released at each level 
     96   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dminl     !: fraction of sinking POC released in sediments 
     97   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dmin3     !: fraction of sinking POC released at each level 
    9598                                                         
    96    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   sedpocb     !: mass of POC in sediments 
    97    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   sedpocn     !: mass of POC in sediments 
    98    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   sedpoca     !: mass of POC in sediments 
     99   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sedpocb   !: mass of POC in sediments 
     100   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sedpocn   !: mass of POC in sediments 
     101   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sedpoca   !: mass of POC in sediments 
    99102                                                         
    100    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   fbod        !: rapid sinking particles 
    101    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   cmask       !: ??? 
     103   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fbod      !: rapid sinking particles 
     104   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   cmask     !: ??? 
    102105 
    103106   !!---------------------------------------------------------------------- 
    104107   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    105108   !! $Id$  
    106    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     109   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    107110   !!---------------------------------------------------------------------- 
    108111CONTAINS 
    … …  
    112115      !!        *** ROUTINE sms_lobster_alloc *** 
    113116      !!---------------------------------------------------------------------- 
    114       USE lib_mpp, ONLY:   ctl_warn   ! MPP library 
    115       INTEGER :: ierr(3)        ! Local variables 
    116       !!---------------------------------------------------------------------- 
    117  
    118       ierr(:) = 0 
    119       !*  Biological parameters 
    120       ALLOCATE( remdmp(jpk,jp_lobster),                               STAT=ierr(1) ) 
    121  
    122       !*  Optical parameters 
    123       ALLOCATE( neln(jpi,jpj)     , xze(jpi,jpj),                         & 
    124         &       xpar(jpi,jpj,jpk) ,                                   STAT=ierr(2) ) 
    125  
    126       !*  Sediment parameters 
    127       ALLOCATE( dminl(jpi,jpj)  , dmin3(jpi,jpj,jpk),                     & 
    128         &       sedpocb(jpi,jpj), sedpocn(jpi,jpj)  , sedpoca(jpi,jpj),   & 
    129         &       fbod(jpi,jpj)   , cmask(jpi,jpj)    ,                 STAT=ierr(3) )  
    130  
    131       sms_lobster_alloc = MAXVAL( ierr ) 
    132    
    133       IF( sms_lobster_alloc /= 0 ) CALL ctl_warn('sms_lobster_alloc : failed to allocate arrays.') 
    134  
     117      ! 
     118      ALLOCATE(                                                                   & 
     119         !*  Biological parameters 
     120         &      remdmp(jpk,jp_lobster) ,                                          & 
     121         !*  Optical parameters 
     122         &      neln   (jpi,jpj) , xze    (jpi,jpj)     , xpar(jpi,jpj,jpk)       & 
     123         !*  Sediment parameters 
     124         &      dminl  (jpi,jpj) , dmin3  (jpi,jpj,jpk) ,                         & 
     125         &      sedpocb(jpi,jpj) , sedpocn(jpi,jpj)     , sedpoca(jpi,jpj)  ,     & 
     126         &      fbod   (jpi,jpj) , cmask  (jpi,jpj)                         , STAT=sms_lobster_alloc )  
     127         ! 
     128      IF( lk_mpp                 )   CALL mpp_sum ( sms_lobster_alloc ) 
     129      IF( sms_lobster_alloc /= 0 )   CALL ctl_warn('sms_lobster_alloc: failed to allocate arrays') 
     130      ! 
    135131   END FUNCTION sms_lobster_alloc 
    136132 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90

    r2643 r2690  
    44   !! TOP :   initialisation of the LOBSTER biological model 
    55   !!====================================================================== 
    6    !! History :    -   !  1999-09  (M. Levy) Original code 
     6   !! History :   OPA  !  1999-09  (M. Levy) Original code 
    77   !!              -   !  2000-12  (0. Aumont, E. Kestenare) add sediment  
    8    !!             1.0  !  2004-03  (C. Ethe) Modularity 
     8   !!   NEMO      1.0  !  2004-03  (C. Ethe) Modularity 
    99   !!              -   !  2005-03  (O. Aumont, A. El Moussaoui) F90 
    1010   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcini.lobster1.h90 
    … …  
    3131   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3232   !! $Id$  
    33    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    34    !!---------------------------------------------------------------------- 
    35  
     33   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     34   !!---------------------------------------------------------------------- 
    3635CONTAINS 
    3736 
    … …  
    4140      !! ** purpose :   specific initialisation for LOBSTER bio-model 
    4241      !!---------------------------------------------------------------------- 
    43       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    44       USE wrk_nemo, ONLY: zrro => wrk_2d_1, zdm0 => wrk_3d_1 
     42      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     43      USE wrk_nemo, ONLY:   zrro => wrk_2d_1 , zdm0 => wrk_3d_1 
    4544      !! 
    4645      INTEGER  ::   ji, jj, jk, jn 
    4746      REAL(wp) ::   ztest, zfluo, zfluu 
    4847      !!---------------------------------------------------------------------- 
     48      ! 
     49      IF(  wrk_in_use(2, 1)  .OR.  wrk_in_use(3, 1)  )  THEN 
     50         CALL ctl_stop('trc_ini_lobster: requested workspace arrays unavailable')   ;  RETURN 
     51      ENDIF 
    4952 
    5053      IF(lwp) WRITE(numout,*) 
    … …  
    5255      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~' 
    5356 
    54  
    55       CALL lobster_alloc()       ! Allocate LOBSTER arrays 
    56  
    57       IF( ( wrk_in_use(2, 1) ) .OR. ( wrk_in_use(3, 1) ) )  THEN 
    58          CALL ctl_stop('trc_ini_lobster : requested workspace arrays unavailable.')   ;  RETURN 
    59       ENDIF 
     57      !                                ! Allocate LOBSTER arrays 
     58      IF( sms_lobster_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_lobster: unable to allocate LOBSTER arrays' ) 
     59 
    6060 
    6161 
    6262      ! initialization of fields for optical model 
    6363      ! -------------------------------------------- 
    64       xze (:,:)   = 5.e0 
    65       xpar(:,:,:) = 0.e0 
     64      xze (:,:)   = 5._wp 
     65      xpar(:,:,:) = 0._wp 
    6666 
    6767      ! initialization for passive tracer remineralisation-damping  array 
    … …  
    7373 
    7474      IF(lwp) THEN 
    75          WRITE(numout,*) ' ' 
    76          WRITE(numout,*) ' trcini: compute remineralisation-damping  ' 
    77          WRITE(numout,*) '         arrays for tracers' 
     75         WRITE(numout,*) 
     76         WRITE(numout,*) ' trcini: compute remineralisation-damping arrays for tracers' 
    7877      ENDIF 
    7978 
    … …  
    8584      ! ------------------------------------------------------------ 
    8685 
    87       zdm0   = 0.e0 
    88       zrro = 1.e0 
    89       DO jk = jpkb,jpkm1 
    90          DO jj =1, jpj 
    91             DO ji =1, jpi 
     86      zdm0 = 0._wp 
     87      zrro = 1._wp 
     88      DO jk = jpkb, jpkm1 
     89         DO jj = 1, jpj 
     90            DO ji = 1, jpi 
    9291               zfluo = ( fsdepw(ji,jj,jk  ) / fsdepw(ji,jj,jpkb) )**xhr  
    9392               zfluu = ( fsdepw(ji,jj,jk+1) / fsdepw(ji,jj,jpkb) )**xhr 
    94                IF( zfluo.GT.1. )   zfluo = 1.e0 
     93               IF( zfluo.GT.1. )   zfluo = 1._wp 
    9594               zdm0(ji,jj,jk) = zfluo - zfluu 
    96                IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0.e0 
     95               IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp 
    9796               zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 
    9897            END DO 
    9998         END DO 
    10099      END DO 
    101  
     100      ! 
    102101      zdm0(:,:,jpk) = zrro(:,:) 
    103102 
    … …  
    106105      ! contains total fraction, which has passed to the upper layers) 
    107106      ! ---------------------------------------------------------------------- 
    108       dminl = 0. 
    109       dmin3 = zdm0 
     107      dminl(:,:)   = 0._wp 
     108      dmin3(:,:,:) = zdm0 
    110109      DO jk = 1, jpk 
    111110         DO jj = 1, jpj 
    112111            DO ji = 1, jpi 
    113                IF( tmask(ji,jj,jk) == 0. ) THEN 
     112               IF( tmask(ji,jj,jk) == 0._wp ) THEN 
    114113                  dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 
    115                   dmin3(ji,jj,jk) = 0.e0 
     114                  dmin3(ji,jj,jk) = 0._wp 
    116115               ENDIF 
    117116            END DO 
    … …  
    121120      DO jj = 1, jpj 
    122121         DO ji = 1, jpi 
    123             IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0.e0 
     122            IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp 
    124123         END DO 
    125124      END DO 
    … …  
    127126      ! Coastal mask  
    128127      ! ------------    
    129       cmask(:,:) = 0.e0 
     128      cmask(:,:) = 0._wp 
    130129      DO ji = 2, jpi-1 
    131130         DO jj = 2, jpj-1 
    132             if (tmask(ji,jj,1) == 1) then 
     131            IF( tmask(ji,jj,1) == 1._wp ) THEN 
    133132               ztest=tmask(ji+1,jj,1)*tmask(ji-1,jj,1)*tmask(ji,jj+1,1)*tmask(ji,jj-1,1) 
    134                IF (ztest == 0) cmask(ji,jj) = 1. 
    135             endif 
     133               IF( ztest == 0 )   cmask(ji,jj) = 1._wp 
     134            ENDIF 
    136135         END DO 
    137136      END DO 
    … …  
    249248 
    250249      !  initialize the POC in sediments 
    251       sedpocb(:,:) = 0.e0 
    252       sedpocn(:,:) = 0.e0 
    253       sedpoca(:,:) = 0.e0 
    254  
    255  
     250      sedpocb(:,:) = 0._wp 
     251      sedpocn(:,:) = 0._wp 
     252      sedpoca(:,:) = 0._wp 
     253      ! 
    256254      IF(lwp) WRITE(numout,*) 'Initialization of LOBSTER tracers done' 
    257       IF(lwp) WRITE(numout,*) ' ' 
    258  
    259       IF( ( wrk_not_released(2, 1) ) .OR. ( wrk_not_released(3, 1) ) )   & 
    260         &      CALL ctl_stop('trc_ini_lobster : failed to release workspace arrays.') 
    261  
     255      ! 
     256      IF(  wrk_not_released(2, 1)  .OR.   & 
     257           wrk_not_released(3, 1)   )   CALL ctl_stop('trc_ini_lobster: failed to release workspace arrays') 
     258      ! 
    262259   END SUBROUTINE trc_ini_lobster 
    263  
    264    SUBROUTINE lobster_alloc 
    265       !!---------------------------------------------------------------------- 
    266       !!                     ***  ROUTINE lobster_alloc  *** 
    267       !! 
    268       !! ** Purpose :   Allocate all the dynamic arrays of LOBSTER 
    269       !!---------------------------------------------------------------------- 
    270  
    271       !                                ! Allocate LOBSTER arrays 
    272       IF( sms_lobster_alloc() /= 0 )   & 
    273       &              CALL ctl_stop( 'STOP', 'trc_ini_lobster : unable to allocate LOBSTER arrays' ) 
    274       ! 
    275    END SUBROUTINE lobster_alloc 
    276260 
    277261#else 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90

    r2643 r2690  
    2424   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    2525   !! $Id$  
    26    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     26   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    2727   !!---------------------------------------------------------------------- 
    28  
    2928CONTAINS 
    3029 
    … …  
    3837      !!---------------------------------------------------------------------- 
    3938 
    40       CALL my_trc_alloc()     ! Allocate MY_TRC arrays 
     39      !                       ! Allocate MY_TRC arrays 
     40      IF( sms_lobster_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_my_trc: unable to allocate MY_TRC arrays' ) 
    4141 
    4242      CALL trc_ctl_my_trc     ! Control consitency 
    … …  
    4747       
    4848      IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 0. 
    49  
    5049      ! 
    5150   END SUBROUTINE trc_ini_my_trc 
    52     
     51 
     52 
    5353   SUBROUTINE trc_ctl_my_trc 
    5454      !!---------------------------------------------------------------------- 
    … …  
    5757      !! ** Purpose :   control the cpp options, namelist and files  
    5858      !!---------------------------------------------------------------------- 
    59  
    6059      INTEGER :: jl, jn 
    61  
     60      !!---------------------------------------------------------------------- 
     61      ! 
    6262      IF(lwp) WRITE(numout,*) 
    6363      IF(lwp) WRITE(numout,*) ' use COLOR tracer ' 
    64  
     64      ! 
    6565      DO jl = 1, jp_my_trc 
    6666         jn = jp_myt0 + jl - 1 
    … …  
    6969         ctrcun(jn)='N/A' 
    7070      END DO 
    71  
    72  
     71      ! 
    7372   END SUBROUTINE trc_ctl_my_trc 
    74  
    75    SUBROUTINE my_trc_alloc 
    76       !!---------------------------------------------------------------------- 
    77       !!                     ***  ROUTINE my_trc_alloc  *** 
    78       !! 
    79       !! ** Purpose :   Allocate all the dynamic arrays of MY_TRC 
    80       !!---------------------------------------------------------------------- 
    81  
    82       !                                ! Allocate MY_TRC arrays 
    83       ! 
    84    END SUBROUTINE my_trc_alloc 
    8573 
    8674#else 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r2528 r2690  
    1010   !!   'key_my_trc'                                               CFC tracers 
    1111   !!---------------------------------------------------------------------- 
    12    !! trc_sms_my_trc   : MY_TRC model main routine  
     12   !! trc_sms_my_trc       : MY_TRC model main routine  
     13   !! trc_sms_my_trc_alloc : allocate arrays specific to MY_TRC sms 
    1314   !!---------------------------------------------------------------------- 
    1415   USE par_trc         ! TOP parameters 
    … …  
    2122   PRIVATE 
    2223 
    23    PUBLIC   trc_sms_my_trc   ! called by trcsms.F90 module 
     24   PUBLIC   trc_sms_my_trc       ! called by trcsms.F90 module 
     25   PUBLIC   trc_sms_my_trc_alloc ! called by trcini_my_trc.F90 module 
    2426 
     27   ! Defined HERE the arrays specific to MY_TRC sms and ALLOCATE them in trc_sms_my_trc_alloc 
     28    
    2529   !!---------------------------------------------------------------------- 
    2630   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    2731   !! $Id$  
    28    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     32   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    2933   !!---------------------------------------------------------------------- 
    30  
    3134CONTAINS 
    3235 
    … …  
    3942      !! ** Method  : -  
    4043      !!---------------------------------------------------------------------- 
    41       INTEGER, INTENT(in) :: kt   ! ocean time-step index 
    42       REAL(wp), DIMENSION(jpi,jpj,jpk)    ::   ztrmyt  
    43       INTEGER :: jn 
    44  
     44      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     45      USE wrk_nemo, ONLY:   ztrmyt => wrk_3d_1   ! used for lobster sms trends 
     46      ! 
     47      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     48      INTEGER ::   jn   ! dummy loop index 
     49      !!---------------------------------------------------------------------- 
    4550 
    4651      IF(lwp) WRITE(numout,*) 
    … …  
    4954 
    5055      WHERE( (glamt <= 170) .AND. (glamt >= 160) .AND. (gphit <= -74) .AND. (gphit >=-75.6) ) 
    51         trn(:,:,1,jpmyt1) = 1. 
    52         trb(:,:,1,jpmyt1) = 1. 
    53         tra(:,:,1,jpmyt1) = 0. 
     56        trn(:,:,1,jpmyt1) = 1._wp 
     57        trb(:,:,1,jpmyt1) = 1._wp 
     58        tra(:,:,1,jpmyt1) = 0._wp 
    5459      END WHERE 
    5560 
    5661      WHERE( ((glamt <= -165) .OR. (glamt >= 160)) .AND. (gphit <= -76) .AND. (gphit >=-80))  
    57         trn(:,:,1,jpmyt2) = 1. 
    58         trb(:,:,1,jpmyt2) = 1. 
    59         tra(:,:,1,jpmyt2) = 0. 
     62        trn(:,:,1,jpmyt2) = 1._wp 
     63        trb(:,:,1,jpmyt2) = 1._wp 
     64        tra(:,:,1,jpmyt2) = 0._wp 
    6065      END WHERE 
    6166 
    62       ! Save the trends in the ixed layer 
    63       IF( l_trdtrc ) THEN 
     67      IF( l_trdtrc ) THEN      ! Save the trends in the ixed layer 
    6468          DO jn = jp_myt0, jp_myt1 
    6569            ztrmyt(:,:,:) = tra(:,:,:,jn) 
    … …  
    6973      ! 
    7074   END SUBROUTINE trc_sms_my_trc 
    71     
     75 
     76 
     77   INTEGER FUNCTION trc_sms_my_trc_alloc() 
     78      !!---------------------------------------------------------------------- 
     79      !!              ***  ROUTINE trc_sms_my_trc_alloc  *** 
     80      !!---------------------------------------------------------------------- 
     81      ! 
     82      ! ALLOCATE here the arrays specific to MY_TRC 
     83      ! ALLOCATE( tab(...) , STAT=trc_sms_my_trc_alloc ) 
     84      trc_sms_my_trc_alloc = 0      ! set to zero if no array to be allocated 
     85      ! 
     86      IF( trc_sms_my_trc_alloc /= 0 ) CALL ctl_warn('trc_sms_my_trc_alloc : failed to allocate arrays') 
     87      ! 
     88   END FUNCTION trc_sms_my_trc_alloc 
     89 
     90 
    7291#else 
    7392   !!---------------------------------------------------------------------- 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90

    r2643 r2690  
    44   !! TOP :   PISCES Sea water chemistry computed following OCMIP protocol 
    55   !!====================================================================== 
    6    !! History :    -   !  1988     (E. Maier-Reimer)  Original code 
     6   !! History :   OPA  !  1988     (E. Maier-Reimer)  Original code 
    77   !!              -   !  1998     (O. Aumont)  addition 
    88   !!              -   !  1999     (C. Le Quere)  modification 
    9    !!             1.0  !  2004     (O. Aumont)  modification 
     9   !!   NEMO      1.0  !  2004     (O. Aumont)  modification 
    1010   !!              -   !  2006     (R. Gangsto)  modification 
    1111   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    … …  
    1515   !!   'key_pisces'                                       PISCES bio-model 
    1616   !!---------------------------------------------------------------------- 
    17    !!   p4z_che        :  Sea water chemistry computed following OCMIP protocol 
    18    !!---------------------------------------------------------------------- 
    19    USE oce_trc         ! 
    20    USE trc         ! 
    21    USE sms_pisces      !  
     17   !!   p4z_che      :  Sea water chemistry computed following OCMIP protocol 
     18   !!---------------------------------------------------------------------- 
     19   USE oce_trc       ! 
     20   USE trc           ! 
     21   USE sms_pisces    !  
     22   USE lib_mpp       ! MPP library 
    2223 
    2324   IMPLICIT NONE 
    2425   PRIVATE 
    2526 
    26    PUBLIC   p4z_che   
    27    PUBLIC   p4z_che_alloc   
    28  
    29    !! * Shared module variables 
    30    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sio3eq  ! chemistry of Si 
    31    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: fekeq   ! chemistry of Fe 
    32    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: chemc   ! Solubilities of O2 and CO2 
    33  
    34    !! * Module variables 
    35  
    36    REAL(wp) :: & 
    37       salchl = 1./1.80655 ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 
    38  
    39    REAL(wp) :: &            ! coeff. for apparent solubility equilibrium  
    40       akcc1 = -171.9065 , &    ! Millero et al. 1995 from Mucci 1983 
    41       akcc2 = -0.077993 , &   
    42       akcc3 = 2839.319  , &   
    43       akcc4 = 71.595    , &   
    44       akcc5 = -0.77712  , &   
    45       akcc6 = 0.0028426 , &   
    46       akcc7 = 178.34    , &   
    47       akcc8 = -0.07711  , &   
    48       akcc9 = 0.0041249 
    49  
    50    REAL(wp) :: &             ! universal gas constants 
    51       rgas = 83.143, & 
    52       oxyco = 1./22.4144 
    53  
    54    REAL(wp) :: &             ! borat constants 
    55       bor1 = 0.00023, & 
    56       bor2 = 1./10.82 
    57  
    58    REAL(wp) :: &              ! 
    59       ca0 = -162.8301  , & 
    60       ca1 = 218.2968   , & 
    61       ca2 = 90.9241    , & 
    62       ca3 = -1.47696   , & 
    63       ca4 = 0.025695   , & 
    64       ca5 = -0.025225  , & 
    65       ca6 = 0.0049867 
    66  
    67    REAL(wp) :: &              ! coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)    
    68       c10 = -3670.7   , & 
    69       c11 = 62.008    , & 
    70       c12 = -9.7944   , & 
    71       c13 = 0.0118    , & 
    72       c14 = -0.000116 
     27   PUBLIC   p4z_che         ! 
     28   PUBLIC   p4z_che_alloc   ! 
     29 
     30   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sio3eq   ! chemistry of Si 
     31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   fekeq    ! chemistry of Fe 
     32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   chemc    ! Solubilities of O2 and CO2 
     33 
     34   REAL(wp) ::   salchl = 1._wp / 1.80655_wp ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 
     35 
     36   REAL(wp) ::   akcc1 = -171.9065_wp      ! coeff. for apparent solubility equilibrium 
     37   REAL(wp) ::   akcc2 =   -0.077993_wp    ! Millero et al. 1995 from Mucci 1983 
     38   REAL(wp) ::   akcc3 = 2839.319_wp       ! 
     39   REAL(wp) ::   akcc4 =   71.595_wp       ! 
     40   REAL(wp) ::   akcc5 =   -0.77712_wp     ! 
     41   REAL(wp) ::   akcc6 =    0.0028426_wp   ! 
     42   REAL(wp) ::   akcc7 =  178.34_wp        ! 
     43   REAL(wp) ::   akcc8 =   -0.07711_wp     ! 
     44   REAL(wp) ::   akcc9 =    0.0041249_wp   ! 
     45 
     46   REAL(wp) ::   rgas  = 83.143_wp         ! universal gas constants 
     47   REAL(wp) ::   oxyco = 1._wp / 22.4144_wp 
     48 
     49   REAL(wp) ::   bor1 = 0.00023_wp         ! borat constants 
     50   REAL(wp) ::   bor2 = 1._wp / 10.82_wp 
     51 
     52   REAL(wp) ::   ca0 = -162.8301_wp 
     53   REAL(wp) ::   ca1 =  218.2968_wp 
     54   REAL(wp) ::   ca2 =   90.9241_wp 
     55   REAL(wp) ::   ca3 =   -1.47696_wp 
     56   REAL(wp) ::   ca4 =    0.025695_wp 
     57   REAL(wp) ::   ca5 =   -0.025225_wp 
     58   REAL(wp) ::   ca6 =    0.0049867_wp 
     59 
     60   REAL(wp) ::   c10 = -3670.7_wp        ! coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)    
     61   REAL(wp) ::   c11 =    62.008_wp      
     62   REAL(wp) ::   c12 =    -9.7944_wp     
     63   REAL(wp) ::   c13 =     0.0118_wp      
     64   REAL(wp) ::   c14 =    -0.000116_wp 
    7365 
    7466   REAL(wp) :: &              ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995)    
    … …  
    132124      ox2 = 23.8439    , & 
    133125      ox3 = -0.034892  , & 
    134       ox4 = 0.015568   , & 
     126      ox4 =  0.015568  , & 
    135127      ox5 = -0.0019387  
    136128 
    … …  
    150142   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    151143   !! $Id$  
    152    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    153    !!---------------------------------------------------------------------- 
    154  
     144   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     145   !!---------------------------------------------------------------------- 
    155146CONTAINS 
    156  
    157147 
    158148   SUBROUTINE p4z_che 
    … …  
    179169!CDIR NOVERRCHK 
    180170         DO ji = 1, jpi 
    181  
    182171            !                             ! SET ABSOLUTE TEMPERATURE 
    183172            ztkel = tsn(ji,jj,1,jp_tem) + 273.16 
    … …  
    324313   END SUBROUTINE p4z_che 
    325314 
     315 
    326316   INTEGER FUNCTION p4z_che_alloc() 
    327317      !!---------------------------------------------------------------------- 
    328318      !!                     ***  ROUTINE p4z_che_alloc  *** 
    329319      !!---------------------------------------------------------------------- 
    330  
    331       ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk),  & 
    332         &       chemc(jpi,jpj,2),                     STAT=p4z_che_alloc ) 
    333  
    334       IF( p4z_che_alloc /= 0 ) CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.') 
    335  
     320      ALLOCATE( sio3eq(jpi,jpj,jpk) , fekeq(jpi,jpj,jpk) , chemc (jpi,jpj,2), STAT=p4z_che_alloc ) 
     321      ! 
     322      IF( p4z_che_alloc /= 0 )   CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.') 
     323      ! 
    336324   END FUNCTION p4z_che_alloc 
     325 
    337326#else 
    338327   !!====================================================================== 
    … …  
    341330CONTAINS 
    342331   SUBROUTINE p4z_che( kt )                   ! Empty routine 
    343       INTEGER, INTENT( in ) ::   kt 
     332      INTEGER, INTENT(in) ::   kt 
    344333      WRITE(*,*) 'p4z_che: You should not have seen this print! error?', kt 
    345334   END SUBROUTINE p4z_che 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90

    r2644 r2690  
    3838   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2   !: atmospheric pco2  
    3939 
    40    REAL(wp)                             ::  t_oce_co2_flx      !: Total ocean carbon flux  
    41    REAL(wp)                             ::  t_atm_co2_flx      !: global mean of atmospheric pco2 
    42    REAL(wp)                             ::  area               !: ocean surface 
    43    REAL(wp)                             ::  atcco2 = 278.      !: pre-industrial atmospheric [co2] (ppm)     
    44    REAL(wp)                             ::  atcox  = 0.20946   !: 
    45    REAL(wp)                             ::  xconv  = 0.01/3600 !: coefficients for conversion  
     40   REAL(wp) ::  t_oce_co2_flx               !: Total ocean carbon flux  
     41   REAL(wp) ::  t_atm_co2_flx               !: global mean of atmospheric pco2 
     42   REAL(wp) ::  area                        !: ocean surface 
     43   REAL(wp) ::  atcco2 = 278._wp            !: pre-industrial atmospheric [co2] (ppm)   
     44   REAL(wp) ::  atcox  = 0.20946_wp         !: 
     45   REAL(wp) ::  xconv  = 0.01_wp / 3600._wp !: coefficients for conversion  
    4646 
    4747   !!* Substitution 
    … …  
    5050   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5151   !! $Id$  
    52    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    53    !!---------------------------------------------------------------------- 
    54  
     52   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     53   !!---------------------------------------------------------------------- 
    5554CONTAINS 
    5655 
    … …  
    6362      !! ** Method  : - ??? 
    6463      !!--------------------------------------------------------------------- 
    65       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    66       USE wrk_nemo, ONLY: zkgco2 => wrk_2d_1, zkgo2 => wrk_2d_2, zh2co3 => wrk_2d_3  
    67       USE wrk_nemo, ONLY: zoflx  => wrk_2d_4, zkg   => wrk_2d_5 
    68       USE wrk_nemo, ONLY: zdpco2 => wrk_2d_6, zdpo2 => wrk_2d_7 
    69       ! 
    70       INTEGER, INTENT(in) :: kt 
     64      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     65      USE wrk_nemo, ONLY:   zkgco2 => wrk_2d_1 , zkgo2 => wrk_2d_2 , zh2co3 => wrk_2d_3  
     66      USE wrk_nemo, ONLY:   zoflx  => wrk_2d_4 , zkg   => wrk_2d_5 
     67      USE wrk_nemo, ONLY:   zdpco2 => wrk_2d_6 , zdpo2 => wrk_2d_7 
     68      ! 
     69      INTEGER, INTENT(in) ::   kt   ! 
     70      ! 
    7171      INTEGER  ::   ji, jj, jrorr 
    7272      REAL(wp) ::   ztc, ztc2, ztc3, zws, zkgwan 
    … …  
    7474      REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 
    7575      CHARACTER (len=25) :: charout 
    76  
    7776      !!--------------------------------------------------------------------- 
    7877 
    7978      IF( wrk_in_use(2, 1,2,3,4,5,6,7) ) THEN 
    80          CALL ctl_stop('p4z_flx: requested workspace arrays unavailable') ; RETURN 
    81       END IF 
     79         CALL ctl_stop('p4z_flx: requested workspace arrays unavailable')   ;  RETURN 
     80      ENDIF 
    8281 
    8382      ! SURFACE CHEMISTRY (PCO2 AND [H+] IN 
    … …  
    213212      CALL iom_put( "Dpo2" , zdpo2  ) 
    214213#endif 
    215  
    216       IF( wrk_not_released(2, 1,2,3,4,5,6,7) ) CALL ctl_stop('p4z_flx: failed to release workspace arrays') 
     214      ! 
     215      IF( wrk_not_released(2, 1,2,3,4,5,6,7) )   CALL ctl_stop('p4z_flx: failed to release workspace arrays') 
    217216      ! 
    218217   END SUBROUTINE p4z_flx 
    219218 
     219 
    220220   SUBROUTINE p4z_flx_init 
    221  
    222221      !!---------------------------------------------------------------------- 
    223222      !!                  ***  ROUTINE p4z_flx_init  *** 
    … …  
    228227      !!      called at the first timestep (nit000) 
    229228      !! ** input   :   Namelist nampisext 
    230       !! 
    231       !!---------------------------------------------------------------------- 
    232  
     229      !!---------------------------------------------------------------------- 
    233230      NAMELIST/nampisext/ atcco2 
    234  
     231      !!---------------------------------------------------------------------- 
     232      ! 
    235233      REWIND( numnat )                     ! read numnat 
    236234      READ  ( numnat, nampisext ) 
    237  
     235      ! 
    238236      IF(lwp) THEN                         ! control print 
    239237         WRITE(numout,*) ' ' 
    … …  
    242240         WRITE(numout,*) '    Atmospheric pCO2      atcco2      =', atcco2 
    243241      ENDIF 
    244  
    245       ! interior global domain surface 
    246       area = glob_sum( e1e2t(:,:) )   
    247  
    248       ! Initialization of Flux of Carbon 
    249       oce_co2(:,:)  = 0._wp 
     242      ! 
     243      area = glob_sum( e1e2t(:,:) )        ! interior global domain surface 
     244      ! 
     245      oce_co2(:,:)  = 0._wp                ! Initialization of Flux of Carbon 
    250246      t_atm_co2_flx = 0._wp 
    251       ! Initialisation of atmospheric pco2 
    252       satmco2(:,:)  = atcco2 
     247      ! 
     248      satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2 
    253249      t_oce_co2_flx = 0._wp 
    254  
     250      ! 
    255251   END SUBROUTINE p4z_flx_init 
    256252 
     253 
    257254   INTEGER FUNCTION p4z_flx_alloc() 
    258255      !!---------------------------------------------------------------------- 
    259256      !!                     ***  ROUTINE p4z_flx_alloc  *** 
    260257      !!---------------------------------------------------------------------- 
    261  
    262258      ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), STAT=p4z_flx_alloc ) 
    263  
    264       IF( p4z_flx_alloc /= 0 ) CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays.') 
    265  
     259      ! 
     260      IF( p4z_flx_alloc /= 0 )   CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays') 
     261      ! 
    266262   END FUNCTION p4z_flx_alloc 
    267263 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90

    r2643 r2690  
    2323   PUBLIC   p4z_int_alloc 
    2424 
    25    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tgfunc  !: Temp. dependancy of various biological rates 
    26    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tgfunc2 !: Temp. dependancy of mesozooplankton rates 
     25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc    !: Temp. dependancy of various biological rates 
     26   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2  !: Temp. dependancy of mesozooplankton rates 
    2727 
    28    !! * Module variables 
    29    REAL(wp) :: xksilim = 16.5E-6   ! Half-saturation constant for the computation of the Si half-saturation constant 
    30  
     28   REAL(wp) ::   xksilim = 16.5e-6_wp   ! Half-saturation constant for the Si half-saturation constant computation 
    3129 
    3230   !!---------------------------------------------------------------------- 
    3331   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3432   !! $Id$  
    35    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     33   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3634   !!---------------------------------------------------------------------- 
    37  
    3835CONTAINS 
    3936 
    … …  
    4643      !! ** Method  : - ??? 
    4744      !!--------------------------------------------------------------------- 
    48       !! 
    4945      INTEGER  ::   ji, jj 
    5046      REAL(wp) ::   zdum 
    … …  
    5349      ! Computation of phyto and zoo metabolic rate 
    5450      ! ------------------------------------------- 
    55  
    5651      tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) ) 
    5752      tgfunc2(:,:,:) = EXP( 0.07608  * tsn(:,:,:,jp_tem) ) 
    … …  
    6055      ! constant for silica uptake 
    6156      ! --------------------------------------------------- 
    62  
    6357      DO ji = 1, jpi 
    6458         DO jj = 1, jpj 
    … …  
    6761         END DO 
    6862      END DO 
    69  
     63      ! 
    7064      IF( nday_year == nyear_len(1) ) THEN 
    7165         xksi    = xksimax 
    72          xksimax = 0.e0 
     66         xksimax = 0._wp 
    7367      ENDIF 
    7468      ! 
    7569   END SUBROUTINE p4z_int 
     70 
    7671 
    7772   INTEGER FUNCTION p4z_int_alloc() 
    … …  
    7974      !!                     ***  ROUTINE p4z_int_alloc  *** 
    8075      !!---------------------------------------------------------------------- 
    81  
    8276      ALLOCATE( tgfunc(jpi,jpj,jpk), tgfunc2(jpi,jpj,jpk), STAT=p4z_int_alloc ) 
    83  
    84       IF( p4z_int_alloc /= 0 ) CALL ctl_warn('p4z_int_alloc : failed to allocate arrays.') 
    85  
     77      ! 
     78      IF( p4z_int_alloc /= 0 )   CALL ctl_warn('p4z_int_alloc : failed to allocate arrays.') 
     79      ! 
    8680   END FUNCTION p4z_int_alloc 
    8781 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90

    r2643 r2690  
    2929   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy                 !: averaged PAR in the mixed layer 
    3030 
    31    INTEGER  ::  nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    32    REAL(wp) ::  parlux = 0.43 / 3.e0 
    33  
    34    REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb  !: tabulated attenuation coefficients for RGB absorption 
     31   INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
     32   REAL(wp) ::   parlux = 0.43_wp / 3._wp 
     33 
     34   REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption 
    3535    
    3636   !!* Substitution 
    … …  
    3939   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4040   !! $Id$  
    41    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    42    !!---------------------------------------------------------------------- 
    43  
     41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     42   !!---------------------------------------------------------------------- 
    4443CONTAINS 
    45  
    4644 
    4745   SUBROUTINE p4z_opt( kt, jnt ) 
    … …  
    5452      !! ** Method  : - ??? 
    5553      !!--------------------------------------------------------------------- 
    56       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    57       USE wrk_nemo, ONLY: zdepmoy => wrk_2d_1, zetmp => wrk_2d_2 
    58       USE wrk_nemo, ONLY: zekg    => wrk_3d_2, zekr  => wrk_3d_3, zekb => wrk_3d_4 
    59       USE wrk_nemo, ONLY: ze0     => wrk_3d_5, ze1   => wrk_3d_6 
    60       USE wrk_nemo, ONLY: ze2     => wrk_3d_7, ze3   => wrk_3d_8 
    61       ! 
    62       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
     54      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     55      USE wrk_nemo, ONLY:   zdepmoy => wrk_2d_1 , zetmp => wrk_2d_2 
     56      USE wrk_nemo, ONLY:   zekg    => wrk_3d_2 , zekr  => wrk_3d_3 , zekb => wrk_3d_4 
     57      USE wrk_nemo, ONLY:   ze0     => wrk_3d_5 , ze1   => wrk_3d_6 
     58      USE wrk_nemo, ONLY:   ze2     => wrk_3d_7 , ze3   => wrk_3d_8 
     59      ! 
     60      INTEGER, INTENT(in) ::   kt, jnt   ! ocean time step 
     61      ! 
    6362      INTEGER  ::   ji, jj, jk 
    6463      INTEGER  ::   irgb 
    … …  
    6766      !!--------------------------------------------------------------------- 
    6867 
    69       IF( ( wrk_in_use(2, 1,2) ) .OR. ( wrk_in_use(3, 2,3,4,5,6,7,8) ) ) THEN 
    70          CALL ctl_stop('p4z_opt: requested workspace arrays unavailable')  ;  RETURN 
    71       END IF 
     68      IF(  wrk_in_use(2, 1,2)   .OR.   wrk_in_use(3, 2,3,4,5,6,7,8)  ) THEN 
     69         CALL ctl_stop('p4z_opt: requested workspace arrays unavailable')   ;   RETURN 
     70      ENDIF 
    7271 
    7372      !     Initialisation of variables used to compute PAR 
    7473      !     ----------------------------------------------- 
    75       ze1 (:,:,jpk) = 0.e0 
    76       ze2 (:,:,jpk) = 0.e0 
    77       ze3 (:,:,jpk) = 0.e0 
     74      ze1 (:,:,jpk) = 0._wp 
     75      ze2 (:,:,jpk) = 0._wp 
     76      ze3 (:,:,jpk) = 0._wp 
    7877 
    7978      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 
    … …  
    211210!CDIR NOVERRCHK 
    212211            DO ji = 1, jpi 
    213                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) & 
    214        &           emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 
     212               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) )   emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 
    215213            END DO 
    216214         END DO 
    … …  
    231229#endif 
    232230      ! 
    233       IF( ( wrk_not_released(2, 1,2) ) .OR. ( wrk_not_released(3, 2,3,4,5,6,7,8) ) ) & 
    234         &         CALL ctl_stop('p4z_opt: failed to release workspace arrays') 
     231      IF(  wrk_not_released(2, 1,2)           .OR.  & 
     232           wrk_not_released(3, 2,3,4,5,6,7,8)   )   CALL ctl_stop('p4z_opt: failed to release workspace arrays') 
    235233      ! 
    236234   END SUBROUTINE p4z_opt 
     235 
    237236 
    238237   SUBROUTINE p4z_opt_init 
    … …  
    241240      !! 
    242241      !! ** Purpose :   Initialization of tabulated attenuation coef 
    243       !! 
    244       !! 
    245       !!---------------------------------------------------------------------- 
    246  
     242      !!---------------------------------------------------------------------- 
     243      ! 
    247244      CALL trc_oce_rgb( xkrgb )                  ! tabulated attenuation coefficients 
    248 !!      CALL trc_oce_rgb_read( xkrgb )               ! tabulated attenuation coefficients 
    249245      nksrp = trc_oce_ext_lev( r_si2, 0.33e2 )     ! max level of light extinction (Blue Chl=0.01) 
     246      ! 
    250247      IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 
    251248      ! 
    252                          etot (:,:,:) = 0.e0 
    253                          enano(:,:,:) = 0.e0 
    254                          ediat(:,:,:) = 0.e0 
    255       IF( ln_qsr_bio )   etot3(:,:,:) = 0.e0 
     249                         etot (:,:,:) = 0._wp 
     250                         enano(:,:,:) = 0._wp 
     251                         ediat(:,:,:) = 0._wp 
     252      IF( ln_qsr_bio )   etot3(:,:,:) = 0._wp 
    256253      !  
    257254   END SUBROUTINE p4z_opt_init 
    258255 
     256 
    259257   INTEGER FUNCTION p4z_opt_alloc() 
    260258      !!---------------------------------------------------------------------- 
    261259      !!                     ***  ROUTINE p4z_opt_alloc  *** 
    262260      !!---------------------------------------------------------------------- 
    263  
    264       ALLOCATE( etot (jpi,jpj,jpk), enano(jpi,jpj,jpk), & 
    265         &       ediat(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 
    266  
     261      ALLOCATE( etot (jpi,jpj,jpk) , enano(jpi,jpj,jpk) ,     & 
     262         &      ediat(jpi,jpj,jpk) , emoy (jpi,jpj,jpk) , STAT=p4z_opt_alloc ) 
     263         ! 
    267264      IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.') 
    268  
     265      ! 
    269266   END FUNCTION p4z_opt_alloc 
    270267 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90

    r2643 r2690  
    2929   PUBLIC   p4z_prod_alloc 
    3030 
    31    !! * Shared module variables 
    3231   REAL(wp), PUBLIC ::   & 
    3332     pislope   = 3.0_wp          ,  &  !: 
    … …  
    4140     grosip    = 0.151_wp 
    4241 
    43    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prmax 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmax   !: 
    4443    
    4544   REAL(wp) ::   & 
    … …  
    5453   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5554   !! $Id$  
    56    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    57    !!---------------------------------------------------------------------- 
    58  
     55   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     56   !!---------------------------------------------------------------------- 
    5957CONTAINS 
    60  
    6158 
    6259   SUBROUTINE p4z_prod( kt , jnt ) 
    … …  
    6966      !! ** Method  : - ??? 
    7067      !!--------------------------------------------------------------------- 
    71       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    72       USE wrk_nemo, ONLY: zmixnano    => wrk_2d_1 , zmixdiat     => wrk_2d_2, zstrn  => wrk_2d_3 
    73       USE wrk_nemo, ONLY: zpislopead  => wrk_3d_2 , zpislopead2 => wrk_3d_2 
    74       USE wrk_nemo, ONLY: zprdia      => wrk_3d_4 , zprbio       => wrk_3d_5, zysopt => wrk_3d_6 
    75       USE wrk_nemo, ONLY: zprorca     => wrk_3d_7 , zprorcad     => wrk_3d_8 
    76       USE wrk_nemo, ONLY: zprofed     => wrk_3d_9 , zprofen      => wrk_3d_10 
    77       USE wrk_nemo, ONLY: zprochln    => wrk_3d_11, zprochld     => wrk_3d_12 
    78       USE wrk_nemo, ONLY: zpronew     => wrk_3d_13, zpronewd     => wrk_3d_14 
     68      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     69      USE wrk_nemo, ONLY:   zmixnano   => wrk_2d_1  , zmixdiat    => wrk_2d_2  , zstrn  => wrk_2d_3 
     70      USE wrk_nemo, ONLY:   zpislopead => wrk_3d_2  , zpislopead2 => wrk_3d_2 
     71      USE wrk_nemo, ONLY:   zprdia     => wrk_3d_4  , zprbio      => wrk_3d_5  , zysopt => wrk_3d_6 
     72      USE wrk_nemo, ONLY:   zprorca    => wrk_3d_7  , zprorcad    => wrk_3d_8 
     73      USE wrk_nemo, ONLY:   zprofed    => wrk_3d_9  , zprofen     => wrk_3d_10 
     74      USE wrk_nemo, ONLY:   zprochln   => wrk_3d_11 , zprochld    => wrk_3d_12 
     75      USE wrk_nemo, ONLY:   zpronew    => wrk_3d_13 , zpronewd    => wrk_3d_14 
    7976      ! 
    8077      INTEGER, INTENT(in) :: kt, jnt 
     78      ! 
    8179      INTEGER  ::   ji, jj, jk 
    8280      REAL(wp) ::   zsilfac, zfact 
    … …  
    9290      !!--------------------------------------------------------------------- 
    9391 
    94       IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2,3,4,5,6,7,8,9,10,11,12,13,14) ) ) THEN 
    95          CALL ctl_stop('p4z_prod: requested workspace arrays unavailable')  ;  RETURN 
    96       END IF 
    97  
    98       zprorca (:,:,:) = 0.0 
    99       zprorcad(:,:,:) = 0.0 
    100       zprofed(:,:,:) = 0.0 
    101       zprofen(:,:,:) = 0.0 
    102       zprochln(:,:,:) = 0.0 
    103       zprochld(:,:,:) = 0.0 
    104       zpronew (:,:,:) = 0.0 
    105       zpronewd(:,:,:) = 0.0 
    106       zprdia  (:,:,:) = 0.0 
    107       zprbio  (:,:,:) = 0.0 
    108       zysopt  (:,:,:) = 0.0 
     92      IF( wrk_in_use(2, 1,2,3)                             .OR.  & 
     93          wrk_in_use(3, 2,3,4,5,6,7,8,9,10,11,12,13,14)  ) THEN 
     94          CALL ctl_stop('p4z_prod: requested workspace arrays unavailable')   ;   RETURN 
     95      ENDIF 
     96 
     97      zprorca (:,:,:) = 0._wp 
     98      zprorcad(:,:,:) = 0._wp 
     99      zprofed (:,:,:) = 0._wp 
     100      zprofen (:,:,:) = 0._wp 
     101      zprochln(:,:,:) = 0._wp 
     102      zprochld(:,:,:) = 0._wp 
     103      zpronew (:,:,:) = 0._wp 
     104      zpronewd(:,:,:) = 0._wp 
     105      zprdia  (:,:,:) = 0._wp 
     106      zprbio  (:,:,:) = 0._wp 
     107      zysopt  (:,:,:) = 0._wp 
    109108 
    110109      ! Computation of the optimal production 
    111  
    112110# if defined key_degrad 
    113111      prmax(:,:,:) = rday1 * tgfunc(:,:,:) * facvol(:,:,:) 
    … …  
    117115 
    118116      ! compute the day length depending on latitude and the day 
    119       zrum = FLOAT( nday_year - 80 ) / REAL(nyear_len(1), wp) 
    120       zcodel = ASIN(  SIN( zrum * rpi * 2. ) * SIN( rad * 23.5 )  ) 
     117      zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 
     118      zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  ) 
    121119 
    122120      ! day length in hours 
    123       zstrn(:,:) = 0. 
     121      zstrn(:,:) = 0._wp 
    124122      DO jj = 1, jpj 
    125123         DO ji = 1, jpi 
    … …  
    362360#endif 
    363361 
    364        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     362      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    365363         WRITE(charout, FMT="('prod')") 
    366364         CALL prt_ctl_trc_info(charout) 
    367365         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    368        ENDIF 
    369  
    370       IF( ( wrk_not_released(2, 1,2,3) ) .OR. ( wrk_not_released(3, 2,3,4,5,6,7,8,9,10,11,12,13,14) ) ) & 
    371         &         CALL ctl_stop('p4z_prod: failed to release workspace arrays') 
     366      ENDIF 
     367 
     368      IF(  wrk_not_released(2, 1,2,3)                          .OR.  & 
     369           wrk_not_released(3, 2,3,4,5,6,7,8,9,10,11,12,13,14)   )   & 
     370           CALL ctl_stop('p4z_prod: failed to release workspace arrays') 
    372371      ! 
    373372   END SUBROUTINE p4z_prod 
    374373 
     374 
    375375   SUBROUTINE p4z_prod_init 
    376  
    377376      !!---------------------------------------------------------------------- 
    378377      !!                  ***  ROUTINE p4z_prod_init  *** 
    … …  
    384383      !! 
    385384      !! ** input   :   Namelist nampisprod 
    386       !! 
    387385      !!---------------------------------------------------------------------- 
    388  
    389386      NAMELIST/nampisprod/ pislope, pislope2, excret, excret2, chlcnm, chlcdm,   & 
    390387         &              fecnm, fecdm, grosip 
     388      !!---------------------------------------------------------------------- 
    391389 
    392390      REWIND( numnat )                     ! read numnat 
    … …  
    407405         WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm     =', fecdm 
    408406      ENDIF 
    409  
     407      ! 
    410408      rday1     = 0.6 / rday  
    411409      texcret   = 1.0 - excret 
    412410      texcret2  = 1.0 - excret2 
    413411      tpp       = 0. 
    414  
     412      ! 
    415413   END SUBROUTINE p4z_prod_init 
    416414 
    … …  
    420418      !!                     ***  ROUTINE p4z_prod_alloc  *** 
    421419      !!---------------------------------------------------------------------- 
    422  
    423420      ALLOCATE( prmax(jpi,jpj,jpk), STAT=p4z_prod_alloc ) 
    424  
     421      ! 
    425422      IF( p4z_prod_alloc /= 0 ) CALL ctl_warn('p4z_prod_alloc : failed to allocate arrays.') 
    426  
     423      ! 
    427424   END FUNCTION p4z_prod_alloc 
    428425 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90

    r2643 r2690  
    3131   PUBLIC   p4z_rem_alloc 
    3232 
    33    !! * Shared module variables 
    3433   REAL(wp), PUBLIC ::   & 
    3534     xremik  = 0.3_wp      ,  & !: 
    … …  
    4039     oxymin  = 1.e-6_wp         !: 
    4140 
    42    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitr  !: denitrification array 
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr   !: denitrification array 
    4342 
    4443 
    … …  
    4847   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4948   !! $Id$  
    50    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    51    !!---------------------------------------------------------------------- 
    52  
     49   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     50   !!---------------------------------------------------------------------- 
    5351CONTAINS 
    54  
    5552 
    5653   SUBROUTINE p4z_rem( kt ) 
    … …  
    6259      !! ** Method  : - ??? 
    6360      !!--------------------------------------------------------------------- 
    64       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    65       USE wrk_nemo, ONLY: ztempbac => wrk_2d_1 
    66       USE wrk_nemo, ONLY: zdepbac  => wrk_3d_2, zfesatur => wrk_3d_2, zolimi => wrk_3d_4 
     61      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     62      USE wrk_nemo, ONLY:   ztempbac => wrk_2d_1 
     63      USE wrk_nemo, ONLY:   zdepbac  => wrk_3d_2 , zfesatur => wrk_3d_2 , zolimi => wrk_3d_4 
    6764      ! 
    6865      INTEGER, INTENT(in) ::   kt ! ocean time step 
     66      ! 
    6967      INTEGER  ::   ji, jj, jk 
    7068      REAL(wp) ::   zremip, zremik , zlam1b 
    … …  
    7876      REAL(wp) ::   zlamfac, zonitr, zstep 
    7977      CHARACTER (len=25) :: charout 
    80  
    8178      !!--------------------------------------------------------------------- 
    8279 
    83       IF( ( wrk_in_use(2, 1) ) .OR. ( wrk_in_use(3, 2,3,4) ) ) THEN 
    84          CALL ctl_stop('p4z_rem: requested workspace arrays unavailable')  ;  RETURN 
    85       END IF 
     80      IF(  wrk_in_use(2, 1)  .OR.  wrk_in_use(3, 2,3,4) ) THEN 
     81         CALL ctl_stop('p4z_rem: requested workspace arrays unavailable')   ;   RETURN 
     82      ENDIF 
    8683 
    8784       ! Initialisation of temprary arrys 
    88        zdepbac (:,:,:) = 0.0 
    89        zfesatur(:,:,:) = 0.0 
    90        zolimi  (:,:,:) = 0.0 
    91        ztempbac(:,:)   = 0.0 
     85       zdepbac (:,:,:) = 0._wp 
     86       zfesatur(:,:,:) = 0._wp 
     87       zolimi  (:,:,:) = 0._wp 
     88       ztempbac(:,:)   = 0._wp 
    9289 
    9390      !  Computation of the mean phytoplankton concentration as 
    9491      !  a crude estimate of the bacterial biomass 
    9592      !   -------------------------------------------------- 
    96  
    9793      DO jk = 1, jpkm1 
    9894         DO jj = 1, jpj 
    … …  
    368364               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 
    369365#endif 
    370  
    371             END DO 
    372          END DO 
    373       END DO 
    374       ! 
    375  
    376        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     366            END DO 
     367         END DO 
     368      END DO 
     369      ! 
     370 
     371      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    377372         WRITE(charout, FMT="('rem5')") 
    378373         CALL prt_ctl_trc_info(charout) 
    379374         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    380        ENDIF 
    381  
    382        !     Update the arrays TRA which contain the biological sources and sinks 
    383        !     -------------------------------------------------------------------- 
     375      ENDIF 
     376 
     377      !     Update the arrays TRA which contain the biological sources and sinks 
     378      !     -------------------------------------------------------------------- 
    384379 
    385380      DO jk = 1, jpkm1 
    … …  
    391386         tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi(:,:,jk) + denitr(:,:,jk) 
    392387         tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + denitr(:,:,jk) * rno3 * rdenit 
    393      END DO 
    394  
    395        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     388      END DO 
     389 
     390      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    396391         WRITE(charout, FMT="('rem6')") 
    397392         CALL prt_ctl_trc_info(charout) 
    398393         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    399        ENDIF 
    400  
    401       IF( ( wrk_not_released(2, 1) ) .OR. ( wrk_not_released(3, 2,3,4) ) )  & 
    402         &         CALL ctl_stop('p4z_rem: failed to release workspace arrays') 
    403  
     394      ENDIF 
     395      ! 
     396      IF(  wrk_not_released(2, 1)     .OR.   & 
     397           wrk_not_released(3, 2,3,4)  )   CALL ctl_stop('p4z_rem: failed to release workspace arrays') 
     398      ! 
    404399   END SUBROUTINE p4z_rem 
    405400 
     401 
    406402   SUBROUTINE p4z_rem_init 
    407  
    408403      !!---------------------------------------------------------------------- 
    409404      !!                  ***  ROUTINE p4z_rem_init  *** 
    … …  
    417412      !! 
    418413      !!---------------------------------------------------------------------- 
    419  
    420414      NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xlam1, oxymin 
     415      !!---------------------------------------------------------------------- 
    421416 
    422417      REWIND( numnat )                     ! read numnat 
    … …  
    434429         WRITE(numout,*) '    halk saturation constant for anoxia       oxymin    =', oxymin 
    435430      ENDIF 
    436  
    437       nitrfac(:,:,:) = 0.0 
    438       denitr (:,:,:) = 0.0   
    439  
     431      ! 
     432      nitrfac(:,:,:) = 0._wp 
     433      denitr (:,:,:) = 0._wp 
     434      ! 
    440435   END SUBROUTINE p4z_rem_init 
     436 
    441437 
    442438   INTEGER FUNCTION p4z_rem_alloc() 
    … …  
    444440      !!                     ***  ROUTINE p4z_rem_alloc  *** 
    445441      !!---------------------------------------------------------------------- 
    446  
    447442      ALLOCATE( denitr(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 
    448  
    449       IF( p4z_rem_alloc /= 0 ) CALL ctl_warn('p4z_rem_alloc : failed to allocate arrays.') 
    450  
     443      ! 
     444      IF( p4z_rem_alloc /= 0 )   CALL ctl_warn('p4z_rem_alloc: failed to allocate arrays') 
     445      ! 
    451446   END FUNCTION p4z_rem_alloc 
     447 
    452448#else 
    453449   !!====================================================================== 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90

    r2643 r2690  
    2323   PUBLIC   p4z_sink_alloc 
    2424 
    25    !! * Shared module variables 
    26    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wsbio3   !: POC sinking speed  
    27    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wsbio4   !: GOC sinking speed 
    28    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wscal    !: Calcite and BSi sinking speeds 
    29  
    30    !! * Module variables 
    31    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinking, sinking2  !: POC sinking fluxes  
    32    !                                                                 !  (different meanings depending on the parameterization) 
    33    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkcal, sinksil   !: CaCO3 and BSi sinking fluxes 
    34    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkfer            !: Small BFe sinking fluxes 
     25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio3   !: POC sinking speed  
     26   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio4   !: GOC sinking speed 
     27   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wscal    !: Calcite and BSi sinking speeds 
     28 
     29   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinking, sinking2  !: POC sinking fluxes  
     30   !                                                          !  (different meanings depending on the parameterization) 
     31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkcal, sinksil   !: CaCO3 and BSi sinking fluxes 
     32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfer            !: Small BFe sinking fluxes 
    3533#if ! defined key_kriest 
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkfer2           !: Big iron sinking fluxes 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfer2           !: Big iron sinking fluxes 
    3735#endif 
    3836 
    … …  
    5654   REAL(wp), PUBLIC ::  xkr_wsbio_max   !: max vertical particle speed 
    5755 
    58    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: xnumm  !:  maximum number of particles in aggregates 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   xnumm   !:  maximum number of particles in aggregates 
    5957#endif 
    6058 
    … …  
    6462   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    6563   !! $Id$  
    66    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     64   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6765   !!---------------------------------------------------------------------- 
    68  
    6966CONTAINS 
    7067 
    71  
    7268#if defined key_kriest 
     69   !!---------------------------------------------------------------------- 
     70   !!   'key_kriest'                                                    ??? 
     71   !!---------------------------------------------------------------------- 
    7372 
    7473   SUBROUTINE p4z_sink ( kt, jnt ) 
    … …  
    8180      !! ** Method  : - ??? 
    8281      !!--------------------------------------------------------------------- 
    83       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    84       USE wrk_nemo, ONLY: znum3d    => wrk_3d_2 
     82      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     83      USE wrk_nemo, ONLY:   znum3d => wrk_3d_2 
     84      ! 
    8585      INTEGER, INTENT(in) :: kt, jnt 
     86      ! 
    8687      INTEGER  :: ji, jj, jk 
    8788      REAL(wp) :: zagg1, zagg2, zagg3, zagg4, zagg5, zaggsi, zaggsh 
    … …  
    9596#endif 
    9697      CHARACTER (len=25) :: charout 
    97  
    98       !!--------------------------------------------------------------------- 
    99  
     98      !!--------------------------------------------------------------------- 
     99      ! 
    100100      IF( wrk_in_use(3, 2 ) ) THEN 
    101          CALL ctl_stop('p4z_sink: requested workspace arrays unavailable')  ;  RETURN 
    102       END IF 
     101         CALL ctl_stop('p4z_sink: requested workspace arrays unavailable')   ;   RETURN 
     102      ENDIF 
     103       
    103104      !     Initialisation of variables used to compute Sinking Speed 
    104105      !     --------------------------------------------------------- 
    105106 
    106        znum3d(:,:,:) = 0.e0 
    107        zval1 = 1. + xkr_zeta 
    108        zval2 = 1. + xkr_zeta + xkr_eta 
    109        zval3 = 1. + xkr_eta 
    110  
    111      !     Computation of the vertical sinking speed : Kriest et Evans, 2000 
    112      !     ----------------------------------------------------------------- 
     107      znum3d(:,:,:) = 0.e0 
     108      zval1 = 1. + xkr_zeta 
     109      zval2 = 1. + xkr_zeta + xkr_eta 
     110      zval3 = 1. + xkr_eta 
     111 
     112      !     Computation of the vertical sinking speed : Kriest et Evans, 2000 
     113      !     ----------------------------------------------------------------- 
    113114 
    114115      DO jk = 1, jpkm1 
    … …  
    128129                  zdiv1 = zeps - zval3 
    129130                  wsbio3(ji,jj,jk) = xkr_wsbio_min * ( zeps - zval1 ) / zdiv    & 
    130      &                             - xkr_wsbio_max *   zgm * xkr_eta  / zdiv 
     131                     &             - xkr_wsbio_max *   zgm * xkr_eta  / zdiv 
    131132                  wsbio4(ji,jj,jk) = xkr_wsbio_min *   ( zeps-1. )    / zdiv1   & 
    132      &                             - xkr_wsbio_max *   zfm * xkr_eta  / zdiv1 
     133                     &             - xkr_wsbio_max *   zfm * xkr_eta  / zdiv1 
    133134                  IF( znum == 1.1)   wsbio3(ji,jj,jk) = wsbio4(ji,jj,jk) 
    134135               ENDIF 
    … …  
    137138      END DO 
    138139 
    139       wscal(:,:,:) = MAX( wsbio3(:,:,:), 50. ) 
     140      wscal(:,:,:) = MAX( wsbio3(:,:,:), 50._wp ) 
    140141 
    141142      !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS 
    … …  
    302303#endif 
    303304      ! 
    304        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     305      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    305306         WRITE(charout, FMT="('sink')") 
    306307         CALL prt_ctl_trc_info(charout) 
    307308         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    308        ENDIF 
    309  
    310       IF( wrk_not_released(3, 2 ) ) CALL ctl_stop('p4z_sink: failed to release workspace arrays') 
     309      ENDIF 
     310      ! 
     311      IF( wrk_not_released(3, 2 ) )   CALL ctl_stop('p4z_sink: failed to release workspace arrays') 
    311312      ! 
    312313   END SUBROUTINE p4z_sink 
     314 
    313315 
    314316   SUBROUTINE p4z_sink_init 
    … …  
    323325      !! 
    324326      !! ** input   :   Namelist nampiskrs 
    325       !! 
    326327      !!---------------------------------------------------------------------- 
    327328      INTEGER  ::   jk, jn, kiter 
    … …  
    329330      REAL(wp) ::   zws, zwr, zwl,wmax, znummax 
    330331      REAL(wp) ::   zmin, zmax, zl, zr, xacc 
    331  
     332      ! 
    332333      NAMELIST/nampiskrs/ xkr_sfact, xkr_stick ,  & 
    333334         &                xkr_nnano, xkr_ndiat, xkr_nmeso, xkr_naggr 
    334  
    335335      !!---------------------------------------------------------------------- 
     336      ! 
    336337      REWIND( numnat )                     ! read nampiskrs 
    337338      READ  ( numnat, nampiskrs ) 
    … …  
    346347         WRITE(numout,*) '    Nbr of cell in mesozoo size class        xkr_nmeso    = ', xkr_nmeso 
    347348         WRITE(numout,*) '    Nbr of cell in aggregates size class     xkr_naggr    = ', xkr_naggr 
    348      ENDIF 
    349  
    350  
    351      ! max and min vertical particle speed 
    352      xkr_wsbio_min = xkr_sfact * xkr_mass_min**xkr_eta 
    353      xkr_wsbio_max = xkr_sfact * xkr_mass_max**xkr_eta 
    354      WRITE(numout,*) ' max and min vertical particle speed ', xkr_wsbio_min, xkr_wsbio_max 
    355  
    356      ! 
    357      !    effect of the sizes of the different living pools on particle numbers 
    358      !    nano = 2um-20um -> mean size=6.32 um -> ws=2.596 -> xnum=xnnano=2.337 
    359      !    diat and microzoo = 10um-200um -> 44.7 -> 8.732 -> xnum=xndiat=3.718 
    360      !    mesozoo = 200um-2mm -> 632.45 -> 45.14 -> xnum=xnmeso=7.147 
    361      !    aggregates = 200um-10mm -> 1414 -> 74.34 -> xnum=xnaggr=9.877 
    362      !    doc aggregates = 1um 
    363      ! ---------------------------------------------------------- 
    364  
    365      xkr_dnano = 1. / ( xkr_massp * xkr_nnano ) 
    366      xkr_ddiat = 1. / ( xkr_massp * xkr_ndiat ) 
    367      xkr_dmeso = 1. / ( xkr_massp * xkr_nmeso ) 
    368      xkr_daggr = 1. / ( xkr_massp * xkr_naggr ) 
     349      ENDIF 
     350 
     351 
     352      ! max and min vertical particle speed 
     353      xkr_wsbio_min = xkr_sfact * xkr_mass_min**xkr_eta 
     354      xkr_wsbio_max = xkr_sfact * xkr_mass_max**xkr_eta 
     355      WRITE(numout,*) ' max and min vertical particle speed ', xkr_wsbio_min, xkr_wsbio_max 
     356 
     357      ! 
     358      !    effect of the sizes of the different living pools on particle numbers 
     359      !    nano = 2um-20um -> mean size=6.32 um -> ws=2.596 -> xnum=xnnano=2.337 
     360      !    diat and microzoo = 10um-200um -> 44.7 -> 8.732 -> xnum=xndiat=3.718 
     361      !    mesozoo = 200um-2mm -> 632.45 -> 45.14 -> xnum=xnmeso=7.147 
     362      !    aggregates = 200um-10mm -> 1414 -> 74.34 -> xnum=xnaggr=9.877 
     363      !    doc aggregates = 1um 
     364      ! ---------------------------------------------------------- 
     365 
     366      xkr_dnano = 1. / ( xkr_massp * xkr_nnano ) 
     367      xkr_ddiat = 1. / ( xkr_massp * xkr_ndiat ) 
     368      xkr_dmeso = 1. / ( xkr_massp * xkr_nmeso ) 
     369      xkr_daggr = 1. / ( xkr_massp * xkr_naggr ) 
    369370 
    370371      !!--------------------------------------------------------------------- 
    … …  
    378379      WRITE(numout,*)'    kriest : Compute maximum number of particles in aggregates' 
    379380 
    380       xacc     =  0.001 
     381      xacc     =  0.001_wp 
    381382      kiter    = 50 
    382       zmin     =  1.10 
     383      zmin     =  1.10_wp 
    383384      zmax     = xkr_mass_max / xkr_mass_min 
    384385      xkr_frac = zmax 
    … …  
    401402            &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    402403            & - wmax 
    403 iflag:  DO jn = 1, kiter 
    404            IF( zwl == 0.e0 ) THEN 
    405               znummax = zl 
    406            ELSE IF ( zwr == 0.e0 ) THEN 
    407               znummax = zr 
    408            ELSE 
    409               znummax = ( zr + zl ) / 2. 
    410               zdiv = xkr_zeta + xkr_eta - xkr_eta * znummax 
    411               znum = znummax - 1. 
    412               zws =  xkr_wsbio_min * xkr_zeta / zdiv & 
    413                  & - ( xkr_wsbio_max * xkr_eta * znum * & 
    414                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    415                  & - wmax 
    416               IF( zws * zwl < 0. ) THEN 
    417                  zr = znummax 
    418               ELSE 
    419                  zl = znummax 
    420               ENDIF 
    421               zdiv = xkr_zeta + xkr_eta - xkr_eta * zl 
    422               znum = zl - 1. 
    423               zwl =  xkr_wsbio_min * xkr_zeta / zdiv & 
    424                  & - ( xkr_wsbio_max * xkr_eta * znum * & 
    425                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    426                  & - wmax 
    427  
    428               zdiv = xkr_zeta + xkr_eta - xkr_eta * zr 
    429               znum = zr - 1. 
    430               zwr =  xkr_wsbio_min * xkr_zeta / zdiv & 
    431                  & - ( xkr_wsbio_max * xkr_eta * znum * & 
    432                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    433                  & - wmax 
    434  
    435               IF ( ABS ( zws )  <= xacc ) EXIT iflag 
    436  
    437            ENDIF 
    438  
    439         END DO iflag 
    440  
    441         xnumm(jk) = znummax 
    442         WRITE(numout,*) '       jk = ', jk, ' wmax = ', wmax,' xnum max = ', xnumm(jk) 
    443  
    444      END DO 
    445  
     404iflag:   DO jn = 1, kiter 
     405            IF    ( zwl == 0._wp ) THEN   ;   znummax = zl 
     406            ELSEIF( zwr == 0._wp ) THEN   ;   znummax = zr 
     407            ELSE 
     408               znummax = ( zr + zl ) / 2. 
     409               zdiv = xkr_zeta + xkr_eta - xkr_eta * znummax 
     410               znum = znummax - 1. 
     411               zws =  xkr_wsbio_min * xkr_zeta / zdiv & 
     412                  & - ( xkr_wsbio_max * xkr_eta * znum * & 
     413                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
     414                  & - wmax 
     415               IF( zws * zwl < 0. ) THEN   ;   zr = znummax 
     416               ELSE                        ;   zl = znummax 
     417               ENDIF 
     418               zdiv = xkr_zeta + xkr_eta - xkr_eta * zl 
     419               znum = zl - 1. 
     420               zwl =  xkr_wsbio_min * xkr_zeta / zdiv & 
     421                  & - ( xkr_wsbio_max * xkr_eta * znum * & 
     422                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
     423                  & - wmax 
     424 
     425               zdiv = xkr_zeta + xkr_eta - xkr_eta * zr 
     426               znum = zr - 1. 
     427               zwr =  xkr_wsbio_min * xkr_zeta / zdiv & 
     428                  & - ( xkr_wsbio_max * xkr_eta * znum * & 
     429                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
     430                  & - wmax 
     431               ! 
     432               IF ( ABS ( zws )  <= xacc ) EXIT iflag 
     433               ! 
     434            ENDIF 
     435            ! 
     436         END DO iflag 
     437 
     438         xnumm(jk) = znummax 
     439         WRITE(numout,*) '       jk = ', jk, ' wmax = ', wmax,' xnum max = ', xnumm(jk) 
     440         ! 
     441      END DO 
     442      ! 
    446443  END SUBROUTINE p4z_sink_init 
    447444 
    … …  
    475472         DO jj = 1, jpj 
    476473            DO ji=1,jpi 
    477                zfact = MAX( 0., fsdepw(ji,jj,jk+1) - hmld(ji,jj) ) / 4000. 
     474               zfact = MAX( 0., fsdepw(ji,jj,jk+1) - hmld(ji,jj) ) / 4000._wp 
    478475               wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 
    479476            END DO 
    … …  
    583580#endif 
    584581      ! 
    585        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     582      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    586583         WRITE(charout, FMT="('sink')") 
    587584         CALL prt_ctl_trc_info(charout) 
    588585         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    589        ENDIF 
    590  
     586      ENDIF 
     587      ! 
    591588   END SUBROUTINE p4z_sink 
     589 
    592590 
    593591   SUBROUTINE p4z_sink_init 
    … …  
    705703      END DO 
    706704 
    707       trn(:,:,:,jp_tra) = trb(:,:,:,jp_tra) 
    708       psinkflx(:,:,:)   = 2. * psinkflx(:,:,:) 
    709  
    710       IF( wrk_not_released(3, 2,3,4 ) ) CALL ctl_stop('p4z_sink2: failed to release workspace arrays') 
     705      trn     (:,:,:,jp_tra) = trb(:,:,:,jp_tra) 
     706      psinkflx(:,:,:)        = 2. * psinkflx(:,:,:) 
     707      ! 
     708      IF( wrk_not_released(3, 2,3,4) )  CALL ctl_stop('p4z_sink2: failed to release workspace arrays') 
    711709      ! 
    712710   END SUBROUTINE p4z_sink2 
     711 
    713712 
    714713   INTEGER FUNCTION p4z_sink_alloc() 
    … …  
    716715      !!                     ***  ROUTINE p4z_sink_alloc  *** 
    717716      !!---------------------------------------------------------------------- 
    718  
    719       ALLOCATE( wsbio3(jpi,jpj,jpk), wsbio4(jpi,jpj,jpk), wscal(jpi,jpj,jpk),  & 
    720         &       sinking(jpi,jpj,jpk), sinking2(jpi,jpj,jpk)                 ,  &                 
    721         &       sinkcal(jpi,jpj,jpk), sinksil(jpi,jpj,jpk)                  ,  &                 
     717      ALLOCATE( wsbio3 (jpi,jpj,jpk) , wsbio4  (jpi,jpj,jpk) , wscal(jpi,jpj,jpk) ,     & 
     718         &      sinking(jpi,jpj,jpk) , sinking2(jpi,jpj,jpk)                      ,     &                 
     719         &      sinkcal(jpi,jpj,jpk) , sinksil (jpi,jpj,jpk)                      ,     &                 
    722720#if defined key_kriest 
    723         &       xnumm(jpk)                                                  ,  &                 
     721         &      xnumm(jpk)                                                        ,     &                 
    724722#else 
    725         &       sinkfer2(jpi,jpj,jpk)                                       ,  &                 
    726 #endif 
    727  
    728         &       sinkfer(jpi,jpj,jpk), STAT=p4z_sink_alloc )                 
    729  
     723         &      sinkfer2(jpi,jpj,jpk)                                             ,     &                 
     724#endif 
     725         &      sinkfer(jpi,jpj,jpk)                                              , STAT=p4z_sink_alloc )                 
     726         ! 
    730727      IF( p4z_sink_alloc /= 0 ) CALL ctl_warn('p4z_sink_alloc : failed to allocate arrays.') 
    731  
     728      ! 
    732729   END FUNCTION p4z_sink_alloc 
     730    
    733731#else 
    734732   !!====================================================================== 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r2643 r2690  
    77   !!             3.2  !  2009-04 (C. Ethe & NEMO team) style 
    88   !!---------------------------------------------------------------------- 
    9  
    109#if defined key_pisces 
    1110   !!---------------------------------------------------------------------- 
    … …  
    8786#endif 
    8887 
     88   !!---------------------------------------------------------------------- 
     89   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     90   !! $Id$  
     91   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     92   !!---------------------------------------------------------------------- 
    8993CONTAINS 
    9094 
    … …  
    9498      !!---------------------------------------------------------------------- 
    9599      USE lib_mpp , ONLY: ctl_warn 
    96       INTEGER :: ierr(5)        ! Local variables 
     100      INTEGER ::   ierr(5)        ! Local variables 
    97101      !!---------------------------------------------------------------------- 
    98  
    99102      ierr(:) = 0 
    100  
     103      ! 
    101104      !*  Biological fluxes for light 
    102105      ALLOCATE( neln(jpi,jpj), heup(jpi,jpj),                           STAT=ierr(1) ) 
    103  
     106      ! 
    104107      !*  Biological fluxes for primary production 
    105108      ALLOCATE( xksimax(jpi,jpj)     , xksi(jpi,jpj)        ,               & 
    … …  
    108111         &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),               & 
    109112         &      concdfe (jpi,jpj,jpk), concnfe (jpi,jpj,jpk),           STAT=ierr(2) )  
    110  
     113         ! 
    111114      !*  SMS for the organic matter 
    112115      ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac (jpi,jpj,jpk),               & 
    … …  
    115118#endif  
    116119         &      xlimbac (jpi,jpj,jpk), xdiss(jpi,jpj,jpk)   ,           STAT=ierr(3) )   
    117  
     120         ! 
    118121      !* Variable for chemistry of the CO2 cycle 
    119122      ALLOCATE( akb3(jpi,jpj,jpk), ak13(jpi,jpj,jpk) ,                      & 
    120123         &      ak23(jpi,jpj,jpk), aksp(jpi,jpj,jpk) ,                      & 
    121124         &      akw3(jpi,jpj,jpk), borat(jpi,jpj,jpk), hi(jpi,jpj,jpk), STAT=ierr(4) ) 
    122  
     125         ! 
    123126      !* Array used to indicate negative tracer values   
    124127      ALLOCATE( xnegtr(jpi,jpj,jpk),                                    STAT=ierr(5) ) 
    125  
     128      ! 
    126129      sms_pisces_alloc = MAXVAL( ierr ) 
    127  
    128       IF( sms_pisces_alloc /= 0 ) CALL ctl_warn('sms_pisces_alloc : failed to allocate arrays.')  
    129  
     130      ! 
     131      IF( sms_pisces_alloc /= 0 )   CALL ctl_warn('sms_pisces_alloc: failed to allocate arrays')  
     132      ! 
    130133   END FUNCTION sms_pisces_alloc 
    131134 
    … …  
    136139#endif 
    137140    
    138    !!---------------------------------------------------------------------- 
    139    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    140    !! $Id$  
    141    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    142141   !!======================================================================    
    143142END MODULE sms_pisces     

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r2643 r2690  
    3434   PUBLIC   trc_ini_pisces   ! called by trcini.F90 module 
    3535 
    36    !! * Module variables 
    37    REAL(wp) :: sco2   =  2.312e-3  
    38    REAL(wp) :: alka0  =  2.423e-3 
    39    REAL(wp) :: oxyg0  =  177.6e-6  
    40    REAL(wp) :: po4    =  2.174e-6  
    41    REAL(wp) :: bioma0 =  1.000e-8   
    42    REAL(wp) :: silic1 =  91.65e-6   
    43    REAL(wp) :: no3    =  31.04e-6 * 7.6 
     36   REAL(wp) :: sco2   =  2.312e-3_wp 
     37   REAL(wp) :: alka0  =  2.423e-3_wp 
     38   REAL(wp) :: oxyg0  =  177.6e-6_wp  
     39   REAL(wp) :: po4    =  2.174e-6_wp  
     40   REAL(wp) :: bioma0 =  1.000e-8_wp   
     41   REAL(wp) :: silic1 =  91.65e-6_wp   
     42   REAL(wp) :: no3    =  31.04e-6_wp * 7.6_wp 
    4443 
    4544#  include "top_substitute.h90" 
    … …  
    4746   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4847   !! $Id$  
    49    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     48   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5049   !!---------------------------------------------------------------------- 
    51  
    5250CONTAINS 
    5351 
    … …  
    5856      !! ** Purpose :   Initialisation of the PISCES biochemical model 
    5957      !!---------------------------------------------------------------------- 
    60  
    61  
     58      ! 
    6259      IF(lwp) WRITE(numout,*) 
    6360      IF(lwp) WRITE(numout,*) ' trc_ini_pisces :   PISCES biochemical model initialisation' 
    6461      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    65  
    6662 
    6763      CALL pisces_alloc()                          ! Allocate PISCES arrays 
    … …  
    130126      IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done' 
    131127      IF(lwp) WRITE(numout,*) ' ' 
    132  
    133128      ! 
    134129   END SUBROUTINE trc_ini_pisces 
     130 
    135131 
    136132   SUBROUTINE pisces_alloc 
    … …  
    162158      ! 
    163159      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    164       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'pisces_alloc : unable to allocate PISCES arrays' ) 
    165  
     160      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'pisces_alloc: unable to allocate PISCES arrays' ) 
    166161      ! 
    167162   END SUBROUTINE pisces_alloc 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r2643 r2690  
    3535   INTEGER ::   nadv   ! choice of the type of advection scheme 
    3636   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra 
    37       !                                ! except at nit000 (=rdttra) if neuler=0 
     37   !                                                    ! except at nit000 (=rdttra) if neuler=0 
    3838 
    3939   !! * Substitutions 
    … …  
    4545   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 
    47  
    4847CONTAINS 
    4948 
    … …  
    6968      !!---------------------------------------------------------------------- 
    7069      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    71       USE wrk_nemo, ONLY: zun => wrk_3d_4, zvn => wrk_3d_5, & 
    72                           zwn => wrk_3d_6   ! effective velocity 
     70      USE wrk_nemo, ONLY: zun => wrk_3d_4, zvn => wrk_3d_5, zwn => wrk_3d_6   ! effective velocity 
    7371      !! 
    74       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    75       ! 
    76       INTEGER :: jk  
    77       CHARACTER (len=22) :: charout 
    78       !!---------------------------------------------------------------------- 
    79  
     72      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     73      ! 
     74      INTEGER ::   jk  
     75      CHARACTER (len=22) ::   charout 
     76      !!---------------------------------------------------------------------- 
     77      ! 
    8078      IF( wrk_in_use(3, 4,5,6) ) THEN 
    81          CALL ctl_stop('trc_adv : requested workspace arrays unavailable.') 
    82          RETURN 
    83       END IF 
     79         CALL ctl_stop('trc_adv : requested workspace arrays unavailable')   ;   RETURN 
     80      ENDIF 
    8481 
    8582      IF( kt == nit000 )   CALL trc_adv_ctl          ! initialisation & control of options 
    … …  
    191188      ! 
    192189   END SUBROUTINE trc_adv_ctl 
     190    
    193191#else 
    194192   !!---------------------------------------------------------------------- 
    … …  
    201199   END SUBROUTINE trc_adv 
    202200#endif 
     201 
    203202  !!====================================================================== 
    204203END MODULE trcadv 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r2606 r2690  
    3333 
    3434   LOGICAL , PUBLIC, PARAMETER ::   lk_trcdmp = .TRUE.   !: internal damping flag 
    35    !                             !!* Namelist namtrc_dmp : passive tracer newtonian damping * 
     35 
     36   !                                !!* Namelist namtrc_dmp : passive tracer newtonian damping * 
    3637   INTEGER  ::   nn_hdmp_tr =   -1   ! = 0/-1/'latitude' for damping over passive tracer 
    3738   INTEGER  ::   nn_zdmp_tr =    0   ! = 0/1/2 flag for damping in the mixed layer 
    … …  
    4849   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4950   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp $  
    50    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    51    !!---------------------------------------------------------------------- 
    52  
     51   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     52   !!---------------------------------------------------------------------- 
    5353CONTAINS 
    5454 
    55    FUNCTION trc_dmp_alloc() 
     55   INTEGER FUNCTION trc_dmp_alloc() 
    5656      !!---------------------------------------------------------------------- 
    5757      !!                   ***  ROUTINE trc_dmp_alloc  *** 
    5858      !!---------------------------------------------------------------------- 
    59       INTEGER :: trc_dmp_alloc 
    60       !!---------------------------------------------------------------------- 
    61  
    62       ALLOCATE(restotr(jpi,jpj,jpk), Stat=trc_dmp_alloc) 
    63  
    64       IF(trc_dmp_alloc /= 0)THEN 
    65          CALL ctl_warn('trc_dmp_alloc : failed to allocate array.') 
    66       END IF 
    67  
     59      ALLOCATE( restotr(jpi,jpj,jpk) , STAT=trc_dmp_alloc ) 
     60      ! 
     61      IF( trc_dmp_alloc /= 0 )   CALL ctl_warn('trc_dmp_alloc: failed to allocate array') 
     62      ! 
    6863   END FUNCTION trc_dmp_alloc 
    6964 
    … …  
    178173      !! 
    179174      !! ** Method  :   read the nammbf namelist and check the parameters 
    180       !!      called by trc_dmp at the first timestep (nit000) 
     175      !!              called by trc_dmp at the first timestep (nit000) 
    181176      !!---------------------------------------------------------------------- 
    182177 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r2643 r2690  
    5757      !!                   ***  ROUTINE trc_nxt_alloc  *** 
    5858      !!---------------------------------------------------------------------- 
    59       ! 
    60       ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc) 
     59      ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc ) 
    6160      ! 
    6261      IF( trc_nxt_alloc /= 0 )   CALL ctl_warn('trc_nxt_alloc : failed to allocate array') 
    … …  
    8988      !! ** Action  : - update trb, trn 
    9089      !!---------------------------------------------------------------------- 
    91       !! * Arguments 
    9290      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    93       !! * Local declarations 
     91      ! 
    9492      INTEGER  ::   jk, jn   ! dummy loop indices 
    9593      REAL(wp) ::   zfact            ! temporary scalar 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r2643 r2690  
    1010   !!---------------------------------------------------------------------- 
    1111   !!   'key_top'                                                TOP models 
    12    !!---------------------------------------------------------------------- 
    1312   !!---------------------------------------------------------------------- 
    1413   !!   trc_ldf     : update the tracer trend with the lateral diffusion 
    … …  
    3332      !                                ! defined from ln_zdf...  namlist logicals) 
    3433   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  r2dt   ! vertical profile time-step, = 2 rdttra 
    35       !                                ! except at nit000 (=rdttra) if neuler=0 
     34      !                                                 ! except at nit000 (=rdttra) if neuler=0 
    3635 
    3736   !! * Substitutions 
    … …  
    4241   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4342   !! $Id$  
    44    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     43   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4544   !!---------------------------------------------------------------------- 
    46  
    4745CONTAINS 
    4846    
    49    FUNCTION trc_zdf_alloc() 
     47   INTEGER FUNCTION trc_zdf_alloc() 
    5048      !!---------------------------------------------------------------------- 
    5149      !!                  ***  ROUTINE trc_zdf_alloc  *** 
    5250      !!---------------------------------------------------------------------- 
    53       INTEGER :: trc_zdf_alloc 
    54       !!---------------------------------------------------------------------- 
    55  
    56       ALLOCATE(r2dt(jpk), Stat=trc_zdf_alloc) 
    57  
    58       IF(trc_zdf_alloc /= 0)THEN 
    59          CALL ctl_warn('trc_zdf_alloc : failed to allocate array.') 
    60       END IF 
    61  
     51      ALLOCATE( r2dt(jpk) , STAT=trc_zdf_alloc ) 
     52      ! 
     53      IF( trc_zdf_alloc /= 0 )   CALL ctl_warn('trc_zdf_alloc : failed to allocate array.') 
     54      ! 
    6255   END FUNCTION trc_zdf_alloc 
    6356 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90

    r2643 r2690  
    7272   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    7373   !! $Header:  $  
    74    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     74   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7575   !!---------------------------------------------------------------------- 
    76  
    7776CONTAINS 
    7877 
    79    FUNCTION trd_mld_trc_alloc() 
     78   INTEGER FUNCTION trd_mld_trc_alloc() 
    8079      !!---------------------------------------------------------------------- 
    8180      !!                  ***  ROUTINE trd_mld_trc_alloc  *** 
    8281      !!---------------------------------------------------------------------- 
    83       INTEGER :: trd_mld_trc_alloc 
    84       !!---------------------------------------------------------------------- 
    85  
    86       ALLOCATE(ztmltrd2(jpi,jpj,jpltrd_trc,jptra), & 
     82      ALLOCATE( ztmltrd2(jpi,jpj,jpltrd_trc,jptra) ,      & 
    8783#if defined key_lobster 
    88                ztmltrdbio2(jpi,jpj,jpdiabio)     , & 
    89 #endif 
    90          &     ndextrd1(jpi*jpj)                 ,  STAT=trd_mld_trc_alloc) 
     84         &      ztmltrdbio2(jpi,jpj,jpdiabio)      ,      & 
     85#endif 
     86         &      ndextrd1(jpi*jpj)                  ,  STAT=trd_mld_trc_alloc) 
    9187         ! 
    9288      IF( lk_mpp                )   CALL mpp_sum ( trd_mld_trc_alloc ) 
    93       IF( trd_mld_trc_alloc /=0 )   CALL ctl_warn('trd_mld_trc_alloc : failed to allocate arrays.') 
     89      IF( trd_mld_trc_alloc /=0 )   CALL ctl_warn('trd_mld_trc_alloc: failed to allocate arrays') 
     90      ! 
    9491   END FUNCTION trd_mld_trc_alloc 
    9592 
    … …  
    115112      !!            surface and the control surface is called "mixed-layer" 
    116113      !!---------------------------------------------------------------------- 
    117       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    118       USE wrk_nemo, ONLY: zvlmsk => wrk_2d_1 
     114      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     115      USE wrk_nemo, ONLY:   zvlmsk => wrk_2d_1 
    119116      !! 
    120117      INTEGER, INTENT( in ) ::   ktrd, kjn                        ! ocean trend index and passive tracer rank 
    … …  
    125122 
    126123      IF( wrk_in_use(2, 1) ) THEN 
    127          CALL ctl_stop('trd_mld_trc_zint : requested workspace array unavailable')   ;   RETURN 
    128       END IF 
     124         CALL ctl_stop('trd_mld_trc_zint: requested workspace array unavailable')   ;   RETURN 
     125      ENDIF 
    129126 
    130127      ! I. Definition of control surface and integration weights 
    … …  
    210207            tmltrd_trc(:,:,ktrd,kjn) = tmltrd_trc(:,:,ktrd,kjn) + ptrc_trdmld(:,:,1) * wkx_trc(:,:,1)  ! non penetrative 
    211208      END SELECT 
    212  
    213       IF( wrk_not_released(2, 1) )   CALL ctl_stop('trd_mld_trc_zint : failed to release workspace array.') 
    214       ! 
    215     END SUBROUTINE trd_mld_trc_zint 
    216  
    217  
    218     SUBROUTINE trd_mld_bio_zint( ptrc_trdmld, ktrd ) 
     209      ! 
     210      IF( wrk_not_released(2, 1) )   CALL ctl_stop('trd_mld_trc_zint: failed to release workspace array') 
     211      ! 
     212   END SUBROUTINE trd_mld_trc_zint 
     213 
     214 
     215   SUBROUTINE trd_mld_bio_zint( ptrc_trdmld, ktrd ) 
    219216      !!---------------------------------------------------------------------- 
    220217      !!                  ***  ROUTINE trd_mld_bio_zint  *** 
    … …  
    234231      !!            surface and the control surface is called "mixed-layer" 
    235232      !!---------------------------------------------------------------------- 
    236       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    237       USE wrk_nemo, ONLY: zvlmsk => wrk_2d_1 
    238       !! 
    239       INTEGER, INTENT( in ) ::   ktrd          ! bio trend index 
    240       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  ptrc_trdmld ! passive trc trend 
     233      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     234      USE wrk_nemo, ONLY:   zvlmsk => wrk_2d_1 
     235      !! 
     236      INTEGER                         , INTENT(in) ::   ktrd          ! bio trend index 
     237      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   ptrc_trdmld  ! passive trc trend 
    241238#if defined key_lobster 
    242       !! local variables 
     239      ! 
    243240      INTEGER ::   ji, jj, jk, isum 
    244241      !!---------------------------------------------------------------------- 
    245242 
    246243      IF( wrk_in_use(2, 1) ) THEN 
    247          CALL ctl_stop('trd_mld_bio_zint : requested workspace array unavailable.') ; RETURN 
    248       END IF 
     244         CALL ctl_stop('trd_mld_bio_zint: requested workspace array unavailable')   ;  RETURN 
     245      ENDIF 
    249246 
    250247      ! I. Definition of control surface and integration weights 
    … …  
    328325      END DO 
    329326 
    330       IF( wrk_not_released(2, 1) ) CALL ctl_stop('trd_mld_bio_zint : failed to release workspace array.') 
    331 #endif 
    332  
    333     END SUBROUTINE trd_mld_bio_zint 
    334  
    335  
    336     SUBROUTINE trd_mld_trc( kt ) 
     327      IF( wrk_not_released(2, 1) )   CALL ctl_stop('trd_mld_bio_zint: failed to release workspace array') 
     328#endif 
     329      ! 
     330   END SUBROUTINE trd_mld_bio_zint 
     331 
     332 
     333   SUBROUTINE trd_mld_trc( kt ) 
    337334      !!---------------------------------------------------------------------- 
    338335      !!                  ***  ROUTINE trd_mld_trc  *** 
    … …  
    385382      USE wrk_nemo, ONLY:   wrk_3d_5, wrk_3d_6, wrk_3d_7, wrk_3d_8, wrk_3d_9 
    386383      ! 
    387       INTEGER, INTENT( in ) ::   kt                               ! ocean time-step index 
     384      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     385      ! 
    388386      INTEGER ::   ji, jj, jk, jl, ik, it, itmod, jn 
    389387      REAL(wp) ::   zavt, zfn, zfn2 
    390       !! 
     388      ! 
    391389      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmltot             ! d(trc)/dt over the anlysis window (incl. Asselin) 
    392390      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlres             ! residual = dh/dt entrainment term 
    393391      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlatf             ! for storage only 
    394392      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlrad             ! for storage only (for trb<0 corr in trcrad) 
    395       !! 
     393      ! 
    396394      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmltot2            ! -+ 
    397395      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlres2            !  | working arrays to diagnose the trends 
    … …  
    400398      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlrad2            !  | (-> for trb<0 corr in trcrad) 
    401399      !REAL(wp), DIMENSION(jpi,jpj,jpltrd_trc,jptra) ::  ztmltrd2  ! -+ 
    402       !! 
     400      ! 
    403401      CHARACTER (LEN= 5) ::   clvar 
    404402#if defined key_dimgout 
    … …  
    423421 
    424422 
    425       IF( nn_dttrc  /= 1  ) CALL ctl_stop( " Be careful, trends diags never validated " ) 
     423      IF( nn_dttrc  /= 1  )   CALL ctl_stop( " Be careful, trends diags never validated " ) 
    426424 
    427425      ! ====================================================================== 
    … …  
    448446 
    449447         DO jn = 1, jptra 
    450          ! ... Remove this K_z trend from the iso-neutral diffusion term (if any) 
     448            ! ... Remove this K_z trend from the iso-neutral diffusion term (if any) 
    451449            IF( ln_trdtrc(jn) ) & 
    452450                 tmltrd_trc(:,:,jpmld_trc_ldf,jn) = tmltrd_trc(:,:,jpmld_trc_ldf,jn) - tmltrd_trc(:,:,jpmld_trc_zdf,jn) 
    … …  
    909907      IF( lrst_trc )   CALL trd_mld_trc_rst_write( kt )  ! this must be after the array swap above (III.3) 
    910908 
    911       IF( wrk_not_released(3, 1,2,3,4,5,6,7,8,9) ) & 
    912       &   CALL ctl_stop('trd_mld_trc : failed to release workspace arrays.') 
     909      IF( wrk_not_released(3, 1,2,3,4,5,6,7,8,9) )   CALL ctl_stop('trd_mld_trc: failed to release workspace arrays') 
    913910      ! 
    914911   END SUBROUTINE trd_mld_trc 
    915912 
    916     SUBROUTINE trd_mld_bio( kt ) 
     913 
     914   SUBROUTINE trd_mld_bio( kt ) 
    917915      !!---------------------------------------------------------------------- 
    918916      !!                  ***  ROUTINE trd_mld  *** 
    … …  
    11491147   END SUBROUTINE trd_mld_bio 
    11501148 
     1149 
    11511150   REAL FUNCTION sum2d( ztab ) 
    11521151      !!---------------------------------------------------------------------- 
    … …  
    11551154      REAL(wp), DIMENSION(jpi,jpj), INTENT( in ) ::  ztab       
    11561155      !!---------------------------------------------------------------------- 
    1157       sum2d = SUM(ztab(2:jpi-1,2:jpj-1)) 
     1156      sum2d = SUM( ztab(2:jpi-1,2:jpj-1) ) 
    11581157   END FUNCTION sum2d 
     1158 
    11591159 
    11601160   SUBROUTINE trd_mld_trc_init 
    … …  
    14421442   !!   Default option :                                       Empty module 
    14431443   !!---------------------------------------------------------------------- 
    1444  
    14451444CONTAINS 
    1446  
    14471445   SUBROUTINE trd_mld_trc( kt )                                   ! Empty routine 
    14481446      INTEGER, INTENT( in) ::   kt 
    14491447      WRITE(*,*) 'trd_mld_trc: You should not have seen this print! error?', kt 
    14501448   END SUBROUTINE trd_mld_trc 
    1451  
    14521449   SUBROUTINE trd_mld_bio( kt ) 
    14531450      INTEGER, INTENT( in) ::   kt 
    14541451      WRITE(*,*) 'trd_mld_bio: You should not have seen this print! error?', kt 
    14551452   END SUBROUTINE trd_mld_bio 
    1456  
    14571453   SUBROUTINE trd_mld_trc_zint( ptrc_trdmld, ktrd, ctype, kjn ) 
    14581454      INTEGER               , INTENT( in ) ::  ktrd, kjn              ! ocean trend index and passive tracer rank 
    … …  
    14641460      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn 
    14651461   END SUBROUTINE trd_mld_trc_zint 
    1466  
    14671462   SUBROUTINE trd_mld_trc_init                                    ! Empty routine 
    14681463      WRITE(*,*) 'trd_mld_trc_init: You should not have seen this print! error?' 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc_oce.F90

    r2643 r2690  
    88   !!   'key_top'                                                TOP models 
    99   !!---------------------------------------------------------------------- 
    10  
    1110   USE par_oce       ! ocean parameters 
    1211   USE par_trc       ! passive tracers parameters 
    … …  
    2322   CHARACTER(len=50) ::  cn_trdrst_trc_in     !: suffix of pass. tracer restart name (input) 
    2423   CHARACTER(len=50) ::  cn_trdrst_trc_out    !: suffix of pass. tracer restart name (output) 
    25    LOGICAL, DIMENSION (jptra) ::   ln_trdtrc  !: large trends diagnostic to write or not (namelist) 
     24   LOGICAL, DIMENSION(jptra) ::   ln_trdtrc   !: large trends diagnostic to write or not (namelist) 
    2625 
    2726# if defined key_trdtrc && defined key_iomput 
    … …  
    117116                                                 !: upper triangle 
    118117#endif 
    119  
    120118   !!---------------------------------------------------------------------- 
    121119   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    122120   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmld_oce.F90,v 1.2 2005/03/27 18:35:23 opalod Exp $  
    123    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     121   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    124122   !!---------------------------------------------------------------------- 
    125123CONTAINS 
    … …  
    132130      INTEGER :: ierr(2) 
    133131      !!---------------------------------------------------------------------- 
    134  
    135132      ierr(:) = 0 
    136  
     133      ! 
    137134# if defined key_trdmld_trc 
    138135      ALLOCATE(nmld_trc(jpi,jpj),          nbol_trc(jpi,jpj),           & 
    … …  
    149146               tmlradn_trc(jpi,jpj,jptra), tmlradm_trc(jpi,jpj,jptra),  & 
    150147               ! 
    151                tmltrd_trc(jpi,jpj,jpltrd_trc,jptra)        , & 
    152                tmltrd_sum_trc(jpi,jpj,jpltrd_trc,jptra)    , & 
    153                tmltrd_csum_ln_trc(jpi,jpj,jpltrd_trc,jptra), & 
    154                tmltrd_csum_ub_trc(jpi,jpj,jpltrd_trc,jptra), & 
     148               tmltrd_trc(jpi,jpj,jpltrd_trc,jptra)         , & 
     149               tmltrd_sum_trc(jpi,jpj,jpltrd_trc,jptra)     , & 
     150               tmltrd_csum_ln_trc(jpi,jpj,jpltrd_trc,jptra) , & 
     151               tmltrd_csum_ub_trc(jpi,jpj,jpltrd_trc,jptra) , & 
    155152               ! 
    156                tmltrdm_trc(jpi,jpj,jptra),                   & 
    157                Stat=ierr(1)) 
     153               tmltrdm_trc(jpi,jpj,jptra)                   , STAT=ierr(1) ) 
    158154#endif 
    159  
     155      ! 
    160156# if defined key_lobster 
    161       ALLOCATE(tmltrd_bio(jpi,jpj,jpdiabio),         & 
    162                tmltrd_sum_bio(jpi,jpj,jpdiabio),     & 
    163                tmltrd_csum_ln_bio(jpi,jpj,jpdiabio), & 
    164                tmltrd_csum_ub_bio(jpi,jpj,jpdiabio), & 
    165                Stat=ierr(2)) 
     157      ALLOCATE( tmltrd_bio        (jpi,jpj,jpdiabio) ,     & 
     158         &      tmltrd_sum_bio    (jpi,jpj,jpdiabio) ,     & 
     159         &      tmltrd_csum_ln_bio(jpi,jpj,jpdiabio) ,     & 
     160         &      tmltrd_csum_ub_bio(jpi,jpj,jpdiabio) , STAT=ierr(2) ) 
    166161# endif 
    167  
     162      ! 
    168163      trd_mod_trc_oce_alloc = MAXVAL(ierr) 
    169  
    170       IF( trd_mod_trc_oce_alloc /= 0 )   CALL ctl_warn('trd_mod_trc_oce_alloc : failed to allocate arrays') 
    171  
     164      ! 
     165      IF( trd_mod_trc_oce_alloc /= 0 )   CALL ctl_warn('trd_mod_trc_oce_alloc: failed to allocate arrays') 
     166      ! 
    172167# if defined key_trdmld_trc 
    173168      jpktrd_trc = jpk      ! Initialise what used to be a parameter - max level for mixed-layer trends diag. 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r2643 r2690  
    1919   PUBLIC 
    2020 
    21    PUBLIC    trc_alloc          ! called by nemogcm.F90 
     21   PUBLIC   trc_alloc   ! called by nemogcm.F90 
    2222 
    2323   !! passive tracers names and units (read in namelist) 
    … …  
    3636   !! passive tracers fields (before,now,after) 
    3737   !! -------------------------------------------------- 
    38    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: cvol   !: volume correction -degrad option-  
    3938   REAL(wp), PUBLIC ::   trai                          !: initial total tracer 
    4039   REAL(wp), PUBLIC ::   areatot                       !: total volume  
    41  
    42    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   trn   !: traceur concentration for actual time step 
    43    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   tra   !: traceur concentration for next time step 
    44    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   trb   !: traceur concentration for before time step 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:)   ::   cvol   !: volume correction -degrad option-  
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   trn    !: traceur concentration for now time step 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   tra    !: traceur concentration for next time step 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   trb    !: traceur concentration for before time step 
    4544 
    4645   !! interpolated gradient 
    4746   !!--------------------------------------------------   
    48    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::   gtru   !: horizontal gradient at u-points at bottom ocean level 
    49    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::   gtrv   !: horizontal gradient at v-points at bottom ocean level 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::   gtru   !: hor. gradient at u-points at bottom ocean level 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::   gtrv   !: hor. gradient at v-points at bottom ocean level 
    5049    
    5150   !! passive tracers restart (input and output) 
    5251   !! ------------------------------------------   
    53    LOGICAL , PUBLIC          ::  ln_rsttr      !: boolean term for restart i/o for passive tracers (namelist) 
    54    LOGICAL , PUBLIC          ::  lrst_trc      !: logical to control the trc restart write 
    55    INTEGER , PUBLIC          ::  nn_dttrc      !: frequency of step on passive tracers 
    56    INTEGER , PUBLIC          ::  nutwrs        !: output FILE for passive tracers restart 
    57    INTEGER , PUBLIC          ::  nutrst        !: logical unit for restart FILE for passive tracers 
    58    INTEGER , PUBLIC          ::  nn_rsttr      !: control of the time step ( 0 or 1 ) for pass. tr. 
    59    CHARACTER(len=50), PUBLIC ::  cn_trcrst_in  !: suffix of pass. tracer restart name (input) 
    60    CHARACTER(len=50), PUBLIC ::  cn_trcrst_out !: suffix of pass. tracer restart name (output) 
     52   LOGICAL          , PUBLIC ::  ln_rsttr        !: boolean term for restart i/o for passive tracers (namelist) 
     53   LOGICAL          , PUBLIC ::  lrst_trc        !: logical to control the trc restart write 
     54   INTEGER          , PUBLIC ::  nn_dttrc        !: frequency of step on passive tracers 
     55   INTEGER          , PUBLIC ::  nutwrs          !: output FILE for passive tracers restart 
     56   INTEGER          , PUBLIC ::  nutrst          !: logical unit for restart FILE for passive tracers 
     57   INTEGER          , PUBLIC ::  nn_rsttr        !: control of the time step ( 0 or 1 ) for pass. tr. 
     58   CHARACTER(len=50), PUBLIC ::  cn_trcrst_in    !: suffix of pass. tracer restart name (input) 
     59   CHARACTER(len=50), PUBLIC ::  cn_trcrst_out   !: suffix of pass. tracer restart name (output) 
    6160    
    6261   !! information for outputs 
    … …  
    6867   !! additional 2D/3D outputs namelist 
    6968   !! -------------------------------------------------- 
    70    INTEGER , PUBLIC                               ::   nn_writedia   !: frequency of additional arrays outputs(namelist) 
    71    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2d      !: 2d output field name 
    72    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2u      !: 2d output field unit    
    73    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3d      !: 3d output field name 
    74    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3u      !: 3d output field unit 
    75    CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2l      !: 2d output field long name 
    76    CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3l      !: 3d output field long name 
     69   INTEGER         , PUBLIC                      ::   nn_writedia   !: frequency of additional arrays outputs(namelist) 
     70   CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia2d) ::   ctrc2d      !: 2d output field name 
     71   CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia2d) ::   ctrc2u      !: 2d output field unit    
     72   CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia3d) ::   ctrc3d      !: 3d output field name 
     73   CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia3d) ::   ctrc3u      !: 3d output field unit 
     74   CHARACTER(len=80), PUBLIC, DIMENSION(jpdia2d) ::   ctrc2l      !: 2d output field long name 
     75   CHARACTER(len=80), PUBLIC, DIMENSION(jpdia3d) ::   ctrc3l      !: 3d output field long name 
    7776 
    78    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,  :) ::   trc2d    !:  additional 2d outputs   
    79    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   trc3d    !:  additional 3d outputs   
     77   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,  :) ::   trc2d    !:  additional 2d outputs   
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trc3d    !:  additional 3d outputs   
    8079# endif 
    8180 
    … …  
    9089   !! Biological trends 
    9190   !! ----------------- 
    92    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trbio   !: biological trends 
     91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trbio   !: biological trends 
    9392# endif 
    9493 
    … …  
    101100 
    102101   !!---------------------------------------------------------------------- 
    103    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     102   !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) 
    104103   !! $Id$  
    105    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     104   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    106105   !!---------------------------------------------------------------------- 
    107106CONTAINS 
    … …  
    114113      !!------------------------------------------------------------------- 
    115114      ! 
    116       ALLOCATE(cvol(jpi,jpj,jpk),                                  & 
    117                trn(jpi,jpj,jpk,jptra),                             & 
    118                tra(jpi,jpj,jpk,jptra),                             & 
    119                trb(jpi,jpj,jpk,jptra),                             & 
    120                gtru(jpi,jpj,jptra), gtrv(jpi,jpj,jptra),           & 
     115      ALLOCATE( cvol(jpi,jpj,jpk      ) ,                           & 
     116         &      trn (jpi,jpj,jpk,jptra) ,                           & 
     117         &      tra (jpi,jpj,jpk,jptra) ,                           & 
     118         &      trb (jpi,jpj,jpk,jptra) ,                           & 
     119         &      gtru(jpi,jpj    ,jptra) , gtrv(jpi,jpj,jptra) ,     & 
    121120# if defined key_diatrc && ! defined key_iomput 
    122                trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), & 
     121         &      trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), & 
    123122# endif 
    124123# if defined key_diabio 
    125                trbio(jpi,jpj,jpk,jpdiabio),                        & 
     124         &      trbio(jpi,jpj,jpk,jpdiabio),                        & 
    126125#endif 
    127                rdttrc(jpk),  STAT=trc_alloc )       
     126               rdttrc(jpk) ,  STAT=trc_alloc )       
    128127 
    129128      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays') 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcdia.F90

    r2643 r2690  
    5757   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5858   !! $Id$  
    59    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     59   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6060   !!---------------------------------------------------------------------- 
    6161CONTAINS 
    62  
    6362 
    6463   SUBROUTINE trc_dia( kt )   
    … …  
    6867      !! ** Purpose :   output passive tracers fields  
    6968      !!--------------------------------------------------------------------- 
    70       INTEGER, INTENT( in ) :: kt 
    71       INTEGER               :: kindic 
     69      INTEGER, INTENT(in) ::   kt   ! ocean time-step 
     70      ! 
     71      INTEGER ::   kindic   ! local integer 
    7272      !!--------------------------------------------------------------------- 
    7373      ! 
    … …  
    9595      !!        IF kindic >0, output of fields before the time step loop 
    9696      !!---------------------------------------------------------------------- 
    97       INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
    98       INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination 
    99       !! 
     97      INTEGER, INTENT(in) ::   kt       ! ocean time-step 
     98      INTEGER, INTENT(in) ::   kindic   ! indicator of abnormal termination 
     99      ! 
    100100      INTEGER ::   jn 
    101101      LOGICAL ::   ll_print = .FALSE. 
    … …  
    216216      IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nit5 ) 
    217217      ! 
    218  
    219218   END SUBROUTINE trcdit_wr 
    220219 
    … …  
    237236      !!        IF kindic >0, output of fields before the time step loop 
    238237      !!---------------------------------------------------------------------- 
    239       INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
    240       INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination 
     238      INTEGER, INTENT(in) ::   kt       ! ocean time-step 
     239      INTEGER, INTENT(in) ::   kindic   ! indicator of abnormal termination 
    241240      !! 
    242241      LOGICAL ::   ll_print = .FALSE. 
    … …  
    364363# else 
    365364   SUBROUTINE trcdii_wr( kt, kindic )                      ! Dummy routine 
    366       INTEGER, INTENT ( in ) :: kt, kindic 
     365      INTEGER, INTENT (in) :: kt, kindic 
    367366   END SUBROUTINE trcdii_wr 
    368367# endif 
    … …  
    400399      ! Initialisation 
    401400      ! -------------- 
    402  
    403401       
    404402      ! local variable for debugging 
    … …  
    485483      IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nitb ) 
    486484      ! 
    487  
    488485   END SUBROUTINE trcdib_wr 
    489486 
    … …  
    500497      !!                     ***  ROUTINE trc_dia_alloc  *** 
    501498      !!--------------------------------------------------------------------- 
    502  
    503499      ALLOCATE( ndext50(jpij*jpk), ndext51(jpij), STAT=trc_dia_alloc ) 
    504  
    505       IF( trc_dia_alloc /= 0 ) CALL ctl_warn('trc_dia_alloc : failed to allocate arrays.') 
    506  
     500      ! 
     501      IF( trc_dia_alloc /= 0 )   CALL ctl_warn('trc_dia_alloc : failed to allocate arrays') 
     502      ! 
    507503   END FUNCTION trc_dia_alloc 
    508504#else 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r2649 r2690  
    2323   PRIVATE 
    2424 
    25    PUBLIC trc_dta         ! called in trcini.F90 and trcdmp.F90 
    26    PUBLIC trc_dta_alloc   ! called in nemogcm.F90 
     25   PUBLIC   trc_dta         ! called in trcini.F90 and trcdmp.F90 
     26   PUBLIC   trc_dta_alloc   ! called in nemogcm.F90 
    2727 
    2828   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .TRUE.   !: temperature data flag 
    … …  
    3131   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   tracdta       ! tracer data at two consecutive times 
    3232   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   nlectr      !: switch for reading once 
    33    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc1       !: number of first month when reading 12 monthly value 
    34    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc2       !: number of second month when reading 12 monthly value 
     33   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc1       !: number of 1st month when reading 12 monthly value 
     34   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc2       !: number of 2nd month when reading 12 monthly value 
    3535 
    3636   !! * Substitutions 
    … …  
    3939   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4040   !! $Id$  
    41    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4242   !!---------------------------------------------------------------------- 
    4343CONTAINS 
    … …  
    5656      !!      two monthly values. 
    5757      !!---------------------------------------------------------------------- 
    58       INTEGER, INTENT( in ) ::   kt     ! ocean time-step 
     58      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
    5959      !! 
    6060      CHARACTER (len=39) ::   clname(jptra) 
    … …  
    199199   END SUBROUTINE trc_dta 
    200200 
     201 
    201202   INTEGER FUNCTION trc_dta_alloc() 
    202203      !!---------------------------------------------------------------------- 
    203204      !!                   ***  ROUTINE trc_dta_alloc  *** 
    204205      !!---------------------------------------------------------------------- 
    205  
    206       ALLOCATE(trdta(jpi,jpj,jpk,jptra),                   & 
    207                tracdta(jpi,jpj,jpk,jptra,2),               & 
    208                nlectr(jptra), ntrc1(jptra), ntrc2(jptra),  &  
    209                ! 
    210                STAT=trc_dta_alloc) 
    211  
    212       IF( trc_dta_alloc /= 0 ) CALL ctl_warn('trc_dta_alloc : failed to allocate arrays.') 
    213  
     206      ALLOCATE( trdta  (jpi,jpj,jpk,jptra  ) ,                    & 
     207         &      tracdta(jpi,jpj,jpk,jptra,2) ,                    & 
     208         &      nlectr(jptra) , ntrc1(jptra) , ntrc2(jptra) , STAT=trc_dta_alloc) 
     209         ! 
     210      IF( trc_dta_alloc /= 0 )   CALL ctl_warn('trc_dta_alloc : failed to allocate arrays') 
     211      ! 
    214212   END FUNCTION trc_dta_alloc 
    215213 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r2649 r2690  
    6464      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    6565 
    66  
    6766      CALL top_alloc()              ! allocate TOP arrays 
    68  
    6967 
    7068      !                             ! masked grid volume 
    … …  
    183181      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules 
    184182      !!---------------------------------------------------------------------- 
    185       ! 
    186183      USE trcadv        , ONLY:   trc_adv_alloc          ! TOP-related alloc routines... 
    187184      USE trc           , ONLY:   trc_alloc 
    … …  
    206203      ! 
    207204      ierr =        trc_adv_alloc()          ! Start of TOP-related alloc routines... 
    208       ierr = ierr + trc_alloc() 
     205      ierr = ierr + trc_alloc    () 
    209206      ierr = ierr + trc_nxt_alloc() 
    210207      ierr = ierr + trc_zdf_alloc() 
Note: See TracChangeset for help on using the changeset viewer.