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 2590 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Ignore:
Timestamp:
2011-02-18T13:49:27+01:00 (13 years ago)
Author:
trackstand2
Message:

Merge branch 'dynamic_memory' into master-svn-dyn

Location:
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC
Files:
16 edited

Legend:

Unmodified
Added
Removed

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

    r2528 r2590  
    6565      !! References :   Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250. 
    6666      !!---------------------------------------------------------------------- 
     67      USE wrk_nemo, ONLY: wrk_use, wrk_release, llwrk_use, llwrk_release 
     68      USE wrk_nemo, ONLY: llwrk_3d_1  
     69      USE wrk_nemo, ONLY: wrk_3d_6, wrk_3d_7 
     70      !! 
    6771      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pt_ice      !  ice surface temperature (Kelvin) 
    6872      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_ice      !  sea-ice thickness 
    … …  
    8286      REAL(wp) ::   zihsc2        ! = 1 hsn >= c2 ; = 0 hsn < c2 
    8387      !! 
    84       LOGICAL , DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   llmask 
    85       REAL(wp), DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   zalbfz    ! = rn_alphdi for freezing ice ; = rn_albice for melting ice 
    86       REAL(wp), DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   zficeth   !  function of ice thickness 
     88      LOGICAL,  POINTER, DIMENSION(:,:,:) ::   llmask    ! Pointer to sub-array of workspace array 
     89      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalbfz    ! = rn_alphdi for freezing ice ; = rn_albice for melting ice 
     90      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zficeth   !  function of ice thickness 
    8791      !!--------------------------------------------------------------------- 
    8892       
    8993      ijpl = SIZE( pt_ice, 3 )                     ! number of ice categories 
     94 
     95      IF( (.not. llwrk_use(3,1)) .OR. (.not. wrk_use(3, 6,7)) )THEN 
     96         CALL ctl_stop('albedo_ice: requested workspace arrays are unavailable.') 
     97         RETURN 
     98      ELSE IF(ijpl > jpk)THEN 
     99         ! 3D workspace arrays have extent jpk in 3rd dimension - check that  
     100         ! ijpl doesn't exceed it. 
     101         CALL ctl_stop('albedo_ice: 3rd dimension of standard workspace arrays too small for them to be used here.') 
     102         RETURN 
     103      ELSE 
     104         ! Associate pointers with sub-arrays of workspace arrays 
     105         llmask  => llwrk_3d_1(:,:,1:ijpl) 
     106         zalbfz  =>   wrk_3d_6(:,:,1:ijpl) 
     107         zficeth =>   wrk_3d_7(:,:,1:ijpl) 
     108      END IF 
    90109 
    91110      IF( albd_init == 0 )   CALL albedo_init      ! initialization  
    … …  
    94113      !  Computation of  zficeth 
    95114      !--------------------------- 
    96       llmask = ( ph_snw == 0.e0 ) .AND. ( pt_ice >= rt0_ice ) 
     115      llmask(:,:,1:ijpl) = ( ph_snw == 0.e0 ) .AND. ( pt_ice >= rt0_ice ) 
    97116      ! ice free of snow and melts 
    98       WHERE( llmask )   ;   zalbfz = rn_albice 
    99       ELSEWHERE         ;   zalbfz = rn_alphdi 
     117      WHERE( llmask(:,:,1:ijpl) )   ;   zalbfz = rn_albice 
     118      ELSEWHERE                     ;   zalbfz = rn_alphdi 
    100119      END WHERE 
    101120 
    … …  
    155174      pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rn_cloud       ! Oberhuber correction 
    156175      ! 
     176      IF( (.not. llwrk_release(3, 1)) .OR. (.not. wrk_release(3, 6,7)) )THEN 
     177         CALL ctl_stop('albedo_ice: failed to release workspace arrays.') 
     178      END IF 
     179      ! 
    157180   END SUBROUTINE albedo_ice 
    158181 
    … …  
    166189      !! ** Method  :   .... 
    167190      !!---------------------------------------------------------------------- 
    168       REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::   pa_oce_os   !  albedo of ocean under overcast sky 
    169       REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::   pa_oce_cs   !  albedo of ocean under clear sky 
     191      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_os   !  albedo of ocean under overcast sky 
     192      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_cs   !  albedo of ocean under clear sky 
    170193      !! 
    171194      REAL(wp) ::   zcoef   ! temporary scalar 

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

    r2528 r2590  
    251251      INTEGER,                      INTENT( IN    )   :: kid       ! variable index in the array 
    252252      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds 
    253       REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done 
     253      REAL(wp),     DIMENSION(:,:), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done 
    254254      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS3 info argument 
    255255      !! 

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

    r2528 r2590  
    117117      !! ** Method  :   OASIS4 MPI communication  
    118118      !!-------------------------------------------------------------------- 
     119      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     120      USE wrk_nemo, ONLY: zclo => wrk_3d_1, zcla => wrk_3d_2 
     121      USE wrk_nemo, ONLY: zlon => wrk_2d_1, zlat => wrk_2d_2 
     122      !! 
    119123      INTEGER, INTENT( IN    )   :: krcv, ksnd     ! Number of received and sent coupling fields 
    120124      ! 
    … …  
    138142      LOGICAL                    :: new_points 
    139143      LOGICAL                    :: new_mask 
    140       LOGICAL                    :: llmask(jpi,jpj,1) 
     144      LOGICAL, ALLOCATABLE, SAVE :: llmask(:,:,:) ! jpi,jpj,1 
    141145 
    142146      INTEGER                    :: ji, jj, jg, jc     ! local loop indicees 
    … …  
    148152      CHARACTER(len=1), DIMENSION(4) :: clgrd = (/ 'T','U','V','F' /)     ! name of the grid points 
    149153 
    150       REAL(kind=wp), DIMENSION(jpi,jpj,4)  :: zclo, zcla 
    151       REAL(kind=wp), DIMENSION(jpi,jpj  )  :: zlon, zlat 
    152  
    153154      TYPE(PRISM_Time_struct)    :: tmpdate 
    154155      INTEGER                    :: idate_incr      ! date increment 
    155156      !! 
    156157      !!-------------------------------------------------------------------- 
     158 
     159      IF( (.not. wrk_use(3, 1,2)) .OR. (.not. wrk_use(2, 1,2)) )THEN 
     160         CALL ctl_stop('cpl_prism_define: ERROR: requested workspace arrays are unavailable.') 
     161         RETURN 
     162      END IF 
    157163 
    158164      IF(lwp) WRITE(numout,*) 
    … …  
    170176      ENDIF 
    171177 
     178      IF(.not. ALLOCATED(mask))THEN 
     179         ALLOCATE(llmask(jpi,jpj,1), Stat=ji) 
     180         IF(ji /= 0)THEN 
     181            CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in allocating llmask' ) 
     182            RETURN 
     183         END IF 
     184      END IF 
    172185 
    173186      ! ----------------------------------------------------------------- 
    … …  
    320333      IF ( nerror /= PRISM_Success )   CALL prism_abort ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef') 
    321334       
     335      IF( (.not. wrk_release(3, 1,2)) .OR. (.not. wrk_release(2, 1,2)) )THEN 
     336         CALL ctl_stop('cpl_prism_define: ERROR: failed to release workspace arrays.') 
     337      END IF 
     338 
    322339   END SUBROUTINE cpl_prism_define 
    323340    
    … …  
    336353      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS4 info argument 
    337354      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds 
    338       REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    )   :: pdata 
     355      REAL(wp),     DIMENSION(:,:), INTENT( IN    )   :: pdata 
    339356      !! 
    340357      !! 
    … …  
    375392      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array 
    376393      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds 
    377       REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done 
     394      REAL(wp),     DIMENSION(:,:), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done 
    378395      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS4 info argument 
    379396      !! 

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

    r2528 r2590  
    596596      !! ** Method  :    
    597597      !!---------------------------------------------------------------------- 
     598      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     599      USE wrk_nemo, ONLY: utmp => wrk_2d_4, vtmp => wrk_2d_5 
     600      !! 
    598601      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step 
    599602      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables 
    … …  
    603606      INTEGER                      ::   ill          ! character length 
    604607      INTEGER                      ::   iv           ! indice of V component 
    605       REAL(wp), DIMENSION(jpi,jpj) ::   utmp, vtmp   ! temporary arrays for vector rotation 
    606608      CHARACTER (LEN=100)          ::   clcomp       ! dummy weight name 
    607609      !!--------------------------------------------------------------------- 
     610 
     611      IF(.not. wrk_use(2, 4,5))THEN 
     612         CALL ctl_stop('fld_rot: ERROR: requested workspace arrays are unavailable.') 
     613         RETURN 
     614      END IF 
     615 
    608616      !! (sga: following code should be modified so that pairs arent searched for each time 
    609617      ! 
    … …  
    638646          ENDIF 
    639647       END DO 
     648 
     649      IF(.not. wrk_release(2, 4,5))THEN 
     650         CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.') 
     651      END IF 
     652 
    640653   END SUBROUTINE fld_rot 
    641654 
    … …  
    813826      !! ** Method  :    
    814827      !!---------------------------------------------------------------------- 
     828      USE wrk_nemo, ONLY: wrk_use, wrk_release, iwrk_use, iwrk_release 
     829      USE wrk_nemo, ONLY: data_tmp => wrk_2d_1 
     830      USE wrk_nemo, ONLY: data_src => iwrk_2d_1 
     831      !! 
    815832      TYPE( FLD ),      INTENT(in)            ::   sd            ! field with name of weights file 
    816833      !! 
    … …  
    821838      CHARACTER (len=5)                       ::   aname 
    822839      INTEGER , DIMENSION(3)                  ::   ddims 
    823       INTEGER , DIMENSION(jpi, jpj)           ::   data_src 
    824       REAL(wp), DIMENSION(jpi, jpj)           ::   data_tmp 
    825840      LOGICAL                                 ::   cyclical 
    826841      INTEGER                                 ::   zwrap         ! temporary integer 
    827842      !!---------------------------------------------------------------------- 
     843      ! 
     844      IF( (.NOT. wrk_use(2, 1)) .OR. (.NOT. iwrk_use(2,1)) )THEN 
     845         CALL ctl_stop('fld_weights: requested workspace arrays are unavailable.') 
     846         RETURN 
     847      END IF 
    828848      ! 
    829849      IF( nxt_wgt > tot_wgts ) THEN 
    … …  
    937957      ENDIF 
    938958 
     959      IF( (.NOT. wrk_release(2, 1)) .OR. (.NOT. iwrk_release(2,1)) )THEN 
     960         CALL ctl_stop('fld_weights: failed to release workspace arrays.') 
     961      END IF 
     962 
    939963   END SUBROUTINE fld_weight 
    940964 
    … …  
    952976      INTEGER,          INTENT(in)                        ::   kw                  ! weights number 
    953977      INTEGER,          INTENT(in)                        ::   kk                  ! vertical dimension of kk 
    954       REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj,kk) ::   dta              ! output field on model grid 
     978      REAL(wp),         INTENT(inout), DIMENSION(:,:,:)  ::   dta              ! output field on model grid 
    955979      INTEGER,          INTENT(in)                        ::   nrec                ! record number to read (ie time slice) 
    956980      !!  

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

    r2528 r2590  
    2828 
    2929   PUBLIC   obs_rot 
    30  
    31    REAL(wp), DIMENSION(jpi,jpj) ::   & 
     30   PUBLIC   geo2oce_alloc ! Called in nemogcm.F90 
     31 
     32   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   & 
    3233      gsint, gcost,   &  ! cos/sin between model grid lines and NP direction at T point 
    3334      gsinu, gcosu,   &  ! cos/sin between model grid lines and NP direction at U point 
    … …  
    3637 
    3738   LOGICAL ::   lmust_init = .TRUE.        !: used to initialize the cos/sin variables (se above) 
     39 
     40   ! Local 'saved' arrays - one set for geo2oce and one set for oce2geo. 
     41   ! Declared here so can be allocated in ge2oce_alloc(). 
     42   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zsinlon_o2g, zcoslon_o2g, zsinlat_o2g, zcoslat_o2g 
     43   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zsinlon_g2o, zcoslon_g2o, zsinlat_g2o, zcoslat_g2o 
    3844 
    3945   !! * Substitutions 
    … …  
    4652 
    4753CONTAINS 
     54 
     55   FUNCTION geo2oce_alloc() 
     56      !!---------------------------------------------------------------------- 
     57      !!                  ***  ROUTINE geo2oce_alloc  *** 
     58      !!---------------------------------------------------------------------- 
     59      IMPLICIT none 
     60      INTEGER :: geo2oce_alloc 
     61 
     62      ALLOCATE(gsint(jpi,jpj), gcost(jpi,jpj),   & 
     63               gsinu(jpi,jpj), gcosu(jpi,jpj),   & 
     64               gsinv(jpi,jpj), gcosv(jpi,jpj),   & 
     65               gsinf(jpi,jpj), gcosf(jpi,jpj),   & 
     66               ! 
     67               zsinlon_o2g(jpi,jpj,4), zcoslon_o2g(jpi,jpj,4), &  
     68               zsinlat_o2g(jpi,jpj,4), zcoslat_o2g(jpi,jpj,4), & 
     69               zsinlon_g2o(jpi,jpj,4), zcoslon_g2o(jpi,jpj,4), & 
     70               zsinlat_g2o(jpi,jpj,4), zcoslat_g2o(jpi,jpj,4), & 
     71               Stat=geo2oce_alloc) 
     72 
     73   END FUNCTION geo2oce_alloc 
     74 
    4875 
    4976   SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1,   & 
    … …  
    347374      INTEGER ::   ig     ! 
    348375      !! * Local save 
    349       REAL(wp), SAVE, DIMENSION(jpi,jpj,4) ::   zsinlon, zcoslon, zsinlat, zcoslat 
    350376      LOGICAL , SAVE, DIMENSION(4)         ::   linit = .FALSE. 
    351377      !!---------------------------------------------------------------------- 
    … …  
    355381            ig = 1 
    356382            IF( .NOT. linit(ig) ) THEN  
    357                zsinlon(:,:,ig) = SIN( rad * glamt(:,:) ) 
    358                zcoslon(:,:,ig) = COS( rad * glamt(:,:) ) 
    359                zsinlat(:,:,ig) = SIN( rad * gphit(:,:) ) 
    360                zcoslat(:,:,ig) = COS( rad * gphit(:,:) ) 
     383               zsinlon_g2o(:,:,ig) = SIN( rad * glamt(:,:) ) 
     384               zcoslon_g2o(:,:,ig) = COS( rad * glamt(:,:) ) 
     385               zsinlat_g2o(:,:,ig) = SIN( rad * gphit(:,:) ) 
     386               zcoslat_g2o(:,:,ig) = COS( rad * gphit(:,:) ) 
    361387               linit(ig) = .TRUE. 
    362388            ENDIF 
    … …  
    364390            ig = 2 
    365391            IF( .NOT. linit(ig) ) THEN  
    366                zsinlon(:,:,ig) = SIN( rad * glamu(:,:) ) 
    367                zcoslon(:,:,ig) = COS( rad * glamu(:,:) ) 
    368                zsinlat(:,:,ig) = SIN( rad * gphiu(:,:) ) 
    369                zcoslat(:,:,ig) = COS( rad * gphiu(:,:) ) 
     392               zsinlon_g2o(:,:,ig) = SIN( rad * glamu(:,:) ) 
     393               zcoslon_g2o(:,:,ig) = COS( rad * glamu(:,:) ) 
     394               zsinlat_g2o(:,:,ig) = SIN( rad * gphiu(:,:) ) 
     395               zcoslat_g2o(:,:,ig) = COS( rad * gphiu(:,:) ) 
    370396               linit(ig) = .TRUE. 
    371397            ENDIF 
    … …  
    373399            ig = 3 
    374400            IF( .NOT. linit(ig) ) THEN  
    375                zsinlon(:,:,ig) = SIN( rad * glamv(:,:) ) 
    376                zcoslon(:,:,ig) = COS( rad * glamv(:,:) ) 
    377                zsinlat(:,:,ig) = SIN( rad * gphiv(:,:) ) 
    378                zcoslat(:,:,ig) = COS( rad * gphiv(:,:) ) 
     401               zsinlon_g2o(:,:,ig) = SIN( rad * glamv(:,:) ) 
     402               zcoslon_g2o(:,:,ig) = COS( rad * glamv(:,:) ) 
     403               zsinlat_g2o(:,:,ig) = SIN( rad * gphiv(:,:) ) 
     404               zcoslat_g2o(:,:,ig) = COS( rad * gphiv(:,:) ) 
    379405               linit(ig) = .TRUE. 
    380406            ENDIF 
    … …  
    382408            ig = 4 
    383409            IF( .NOT. linit(ig) ) THEN  
    384                zsinlon(:,:,ig) = SIN( rad * glamf(:,:) ) 
    385                zcoslon(:,:,ig) = COS( rad * glamf(:,:) ) 
    386                zsinlat(:,:,ig) = SIN( rad * gphif(:,:) ) 
    387                zcoslat(:,:,ig) = COS( rad * gphif(:,:) ) 
     410               zsinlon_g2o(:,:,ig) = SIN( rad * glamf(:,:) ) 
     411               zcoslon_g2o(:,:,ig) = COS( rad * glamf(:,:) ) 
     412               zsinlat_g2o(:,:,ig) = SIN( rad * gphif(:,:) ) 
     413               zcoslat_g2o(:,:,ig) = COS( rad * gphif(:,:) ) 
    388414               linit(ig) = .TRUE. 
    389415            ENDIF 
    … …  
    393419      END SELECT 
    394420       
    395       pte = - zsinlon(:,:,ig) * pxx + zcoslon(:,:,ig) * pyy 
    396       ptn = - zcoslon(:,:,ig) * zsinlat(:,:,ig) * pxx    & 
    397             - zsinlon(:,:,ig) * zsinlat(:,:,ig) * pyy    & 
    398             + zcoslat(:,:,ig) * pzz 
     421      pte = - zsinlon_g2o(:,:,ig) * pxx + zcoslon_g2o(:,:,ig) * pyy 
     422      ptn = - zcoslon_g2o(:,:,ig) * zsinlat_g2o(:,:,ig) * pxx    & 
     423            - zsinlon_g2o(:,:,ig) * zsinlat_g2o(:,:,ig) * pyy    & 
     424            + zcoslat_g2o(:,:,ig) * pzz 
    399425!!$   ptv =   zcoslon(:,:,ig) * zcoslat(:,:,ig) * pxx    & 
    400426!!$         + zsinlon(:,:,ig) * zcoslat(:,:,ig) * pyy    & 
    … …  
    415441      !!        !         (A. Caubel)  oce2geo - Original code 
    416442      !!---------------------------------------------------------------------- 
    417       REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    ) ::  pte, ptn 
    418       CHARACTER(len=1)            , INTENT( IN    ) ::  cgrid 
    419       REAL(wp), DIMENSION(jpi,jpj), INTENT(   OUT ) ::  pxx , pyy , pzz 
     443      REAL(wp), DIMENSION(:,:), INTENT( IN    ) ::  pte, ptn 
     444      CHARACTER(len=1)        , INTENT( IN    ) ::  cgrid 
     445      REAL(wp), DIMENSION(:,:), INTENT(   OUT ) ::  pxx , pyy , pzz 
    420446      !! 
    421447      REAL(wp), PARAMETER :: rpi = 3.141592653E0 
    … …  
    423449      INTEGER ::   ig     ! 
    424450      !! * Local save 
    425       REAL(wp), SAVE, DIMENSION(jpi,jpj,4) ::   zsinlon, zcoslon, zsinlat, zcoslat 
    426451      LOGICAL , SAVE, DIMENSION(4)         ::   linit = .FALSE. 
    427452      !!---------------------------------------------------------------------- 
    … …  
    431456            ig = 1 
    432457            IF( .NOT. linit(ig) ) THEN  
    433                zsinlon(:,:,ig) = SIN( rad * glamt(:,:) ) 
    434                zcoslon(:,:,ig) = COS( rad * glamt(:,:) ) 
    435                zsinlat(:,:,ig) = SIN( rad * gphit(:,:) ) 
    436                zcoslat(:,:,ig) = COS( rad * gphit(:,:) ) 
     458               zsinlon_o2g(:,:,ig) = SIN( rad * glamt(:,:) ) 
     459               zcoslon_o2g(:,:,ig) = COS( rad * glamt(:,:) ) 
     460               zsinlat_o2g(:,:,ig) = SIN( rad * gphit(:,:) ) 
     461               zcoslat_o2g(:,:,ig) = COS( rad * gphit(:,:) ) 
    437462               linit(ig) = .TRUE. 
    438463            ENDIF 
    … …  
    440465            ig = 2 
    441466            IF( .NOT. linit(ig) ) THEN  
    442                zsinlon(:,:,ig) = SIN( rad * glamu(:,:) ) 
    443                zcoslon(:,:,ig) = COS( rad * glamu(:,:) ) 
    444                zsinlat(:,:,ig) = SIN( rad * gphiu(:,:) ) 
    445                zcoslat(:,:,ig) = COS( rad * gphiu(:,:) ) 
     467               zsinlon_o2g(:,:,ig) = SIN( rad * glamu(:,:) ) 
     468               zcoslon_o2g(:,:,ig) = COS( rad * glamu(:,:) ) 
     469               zsinlat_o2g(:,:,ig) = SIN( rad * gphiu(:,:) ) 
     470               zcoslat_o2g(:,:,ig) = COS( rad * gphiu(:,:) ) 
    446471               linit(ig) = .TRUE. 
    447472            ENDIF 
    … …  
    449474            ig = 3 
    450475            IF( .NOT. linit(ig) ) THEN  
    451                zsinlon(:,:,ig) = SIN( rad * glamv(:,:) ) 
    452                zcoslon(:,:,ig) = COS( rad * glamv(:,:) ) 
    453                zsinlat(:,:,ig) = SIN( rad * gphiv(:,:) ) 
    454                zcoslat(:,:,ig) = COS( rad * gphiv(:,:) ) 
     476               zsinlon_o2g(:,:,ig) = SIN( rad * glamv(:,:) ) 
     477               zcoslon_o2g(:,:,ig) = COS( rad * glamv(:,:) ) 
     478               zsinlat_o2g(:,:,ig) = SIN( rad * gphiv(:,:) ) 
     479               zcoslat_o2g(:,:,ig) = COS( rad * gphiv(:,:) ) 
    455480               linit(ig) = .TRUE. 
    456481            ENDIF 
    … …  
    458483            ig = 4 
    459484            IF( .NOT. linit(ig) ) THEN  
    460                zsinlon(:,:,ig) = SIN( rad * glamf(:,:) ) 
    461                zcoslon(:,:,ig) = COS( rad * glamf(:,:) ) 
    462                zsinlat(:,:,ig) = SIN( rad * gphif(:,:) ) 
    463                zcoslat(:,:,ig) = COS( rad * gphif(:,:) ) 
     485               zsinlon_o2g(:,:,ig) = SIN( rad * glamf(:,:) ) 
     486               zcoslon_o2g(:,:,ig) = COS( rad * glamf(:,:) ) 
     487               zsinlat_o2g(:,:,ig) = SIN( rad * gphif(:,:) ) 
     488               zcoslat_o2g(:,:,ig) = COS( rad * gphif(:,:) ) 
    464489               linit(ig) = .TRUE. 
    465490            ENDIF 
    … …  
    469494      END SELECT 
    470495 
    471        pxx = - zsinlon(:,:,ig) * pte - zcoslon(:,:,ig) * zsinlat(:,:,ig) * ptn  
    472        pyy =   zcoslon(:,:,ig) * pte - zsinlon(:,:,ig) * zsinlat(:,:,ig) * ptn 
    473        pzz =   zcoslat(:,:,ig) * ptn 
     496       pxx = - zsinlon_o2g(:,:,ig) * pte - zcoslon_o2g(:,:,ig) * zsinlat_o2g(:,:,ig) * ptn  
     497       pyy =   zcoslon_o2g(:,:,ig) * pte - zsinlon_o2g(:,:,ig) * zsinlat_o2g(:,:,ig) * ptn 
     498       pzz =   zcoslat_o2g(:,:,ig) * ptn 
    474499 
    475500       
    … …  
    496521      !!---------------------------------------------------------------------- 
    497522      !! * Arguments 
    498       REAL(wp), INTENT( IN   ), DIMENSION(jpi,jpj) ::   & 
     523      REAL(wp), INTENT( IN   ), DIMENSION(:,:) ::   & 
    499524         px1, py1          ! two horizontal components to be rotated 
    500       REAL(wp), INTENT( OUT  ), DIMENSION(jpi,jpj) ::   & 
     525      REAL(wp), INTENT( OUT  ), DIMENSION(:,:) ::   & 
    501526         px2, py2          ! the two horizontal components in the model repere 
    502527      INTEGER, INTENT( IN ) ::   & 

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

    r2528 r2590  
    2222   PRIVATE 
    2323 
     24   PUBLIC sbc_ice_alloc ! called in nemogcm.F90 
     25 
    2426# if defined  key_lim2 
    2527   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .TRUE.   !: LIM-2 ice model 
    … …  
    3739# endif 
    3840 
    39    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qns_ice   !: non solar heat flux over ice                         [W/m2] 
    40    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qsr_ice   !: solar heat flux over ice                             [W/m2] 
    41    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qla_ice   !: latent flux over ice                                 [W/m2] 
    42    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   dqla_ice  !: latent sensibility over ice                          [W/m2/K] 
    43    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   dqns_ice  !: non solar heat flux sensibility over ice (LW+SEN+LA) [W/m2/K] 
    44    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   tn_ice    !: ice surface temperature                              [K] 
    45    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   alb_ice   !: albedo of ice 
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice   !: non solar heat flux over ice                         [W/m2] 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice   !: solar heat flux over ice                             [W/m2] 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice   !: latent flux over ice                                 [W/m2] 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice  !: latent sensibility over ice                          [W/m2/K] 
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqns_ice  !: non solar heat flux sensibility over ice (LW+SEN+LA) [W/m2/K] 
     46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice    !: ice surface temperature                              [K] 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   alb_ice   !: albedo of ice 
    4648 
    47    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utau_ice    !: u-stress over ice (I-pt for VP or U,V-pts for EVP)   [N/m2] 
    48    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtau_ice    !: v-stress over ice (I-pt for VP or U,V-pts for EVP)   [N/m2] 
    49    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr1_i0      !: 1st fraction of Qsr which penetrates inside the ice cover 
    50    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr2_i0      !: 2nd fraction of Qsr which penetrates inside the ice cover 
    51    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp_ice     !: solid freshwater budget over ice: sublivation - snow 
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_ice    !: u-stress over ice (I-pt for VP or U,V-pts for EVP)   [N/m2] 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau_ice    !: v-stress over ice (I-pt for VP or U,V-pts for EVP)   [N/m2] 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr1_i0      !: 1st fraction of Qsr which penetrates inside the ice cover 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr2_i0      !: 2nd fraction of Qsr which penetrates inside the ice cover 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_ice     !: solid freshwater budget over ice: sublivation - snow 
    5254 
    5355# if defined key_lim3 
    54    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tatm_ice    !: air temperature 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tatm_ice    !: air temperature 
    5557# endif 
     58 
     59CONTAINS 
     60 
     61  FUNCTION sbc_ice_alloc() 
     62    !!---------------------------------------------------------------------- 
     63    !!---------------------------------------------------------------------- 
     64    IMPLICIT none 
     65    INTEGER :: sbc_ice_alloc 
     66    !!---------------------------------------------------------------------- 
     67  
     68    ALLOCATE(qns_ice(jpi,jpj,jpl),  qsr_ice(jpi,jpj,jpl),               & 
     69             qla_ice(jpi,jpj,jpl),  dqla_ice(jpi,jpj,jpl),              & 
     70             dqns_ice(jpi,jpj,jpl), tn_ice(jpi,jpj,jpl),                & 
     71             alb_ice(jpi,jpj,jpl),                                      & 
     72             utau_ice(jpi,jpj),     vtau_ice(jpi,jpj), fr1_i0(jpi,jpj), & 
     73             fr2_i0(jpi,jpj),       emp_ice(jpi,jpj),                   & 
     74             Stat=sbc_ice_alloc) 
     75 
     76  END FUNCTION sbc_ice_alloc 
    5677 
    5778#else 

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

    r2528 r2590  
    1414   IMPLICIT NONE 
    1515   PRIVATE 
    16     
     16 
     17   PUBLIC sbc_oce_alloc ! routine called in nemogcm.F90 
     18 
    1719   !!---------------------------------------------------------------------- 
    1820   !!           Namelist for the Ocean Surface Boundary Condition 
    … …  
    3941   LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress) 
    4042   !!                                   !!   now    ! before   !! 
    41    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2] 
    42    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2] 
    43    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   taum              !: module of sea surface stress (at T-point)    [N/m2]  
    44    !! wndm is used only in PISCES to compute surface gases exchanges in ice-free ocean or leads 
    45    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s] 
    46    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr               !: sea heat flux:     solar                     [W/m2] 
    47    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2] 
    48    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2] 
    49    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns_tot           !: total non solar heat flux (over sea and ice) [W/m2] 
    50    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp    , emp_b    !: freshwater budget: volume flux               [Kg/m2/s] 
    51    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emps   , emps_b   !: freshwater budget: concentration/dillution   [Kg/m2/s] 
    52    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s] 
    53    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rnf    , rnf_b    !: river runoff   [Kg/m2/s]   
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2] 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2] 
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   taum              !: module of sea surface stress (at T-point)    [N/m2]  
     46   !! wndm is used onmpute surface gases exchanges in ice-free ocean or leads 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s] 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2] 
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2] 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2] 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns_tot           !: total non solar heat flux (over sea and ice) [W/m2] 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp    , emp_b    !: freshwater budget: volume flux               [Kg/m2/s] 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emps   , emps_b   !: freshwater budget: concentration/dillution   [Kg/m2/s] 
     54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s] 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff   [Kg/m2/s]   
    5456   !! 
    55    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] 
    56    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   qsr_hc , qsr_hc_b   !: heat content trend due to qsr flux     [K.m/s] 
     57   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] jpi,jpj,jpts 
     58   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  qsr_hc , qsr_hc_b   !: heat content trend due to qsr flux     [K.m/s] jpi,jpj,jpk 
    5759   !! 
    58    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tprecip           !: total precipitation                          [Kg/m2/s] 
    59    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sprecip           !: solid precipitation                          [Kg/m2/s] 
    60    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1) 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tprecip           !: total precipitation                          [Kg/m2/s] 
     61   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sprecip           !: solid precipitation                          [Kg/m2/s] 
     62   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1) 
    6163#if defined key_cpl_carbon_cycle 
    62    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   atm_co2           !: atmospheric pCO2                             [ppm] 
     64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm] 
    6365#endif 
    6466 
    … …  
    6769   !!---------------------------------------------------------------------- 
    6870   INTEGER , PUBLIC                     ::   nn_fsbc   !: frequency of sbc computation (as well as sea-ice model) 
    69    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ssu_m     !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s] 
    70    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ssv_m     !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s] 
    71    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sst_m     !: mean (nn_fsbc time-step) surface sea temperature     [Celsius] 
    72    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sss_m     !: mean (nn_fsbc time-step) surface sea salinity            [psu] 
    73    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m] 
     71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssu_m     !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s] 
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssv_m     !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s] 
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sst_m     !: mean (nn_fsbc time-step) surface sea temperature     [Celsius] 
     74   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sss_m     !: mean (nn_fsbc time-step) surface sea salinity            [psu] 
     75   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m] 
    7476 
    7577   !!---------------------------------------------------------------------- 
    … …  
    7880   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7981   !!====================================================================== 
     82CONTAINS 
     83 
     84   FUNCTION sbc_oce_alloc() 
     85      !!--------------------------------------------------------------------- 
     86      !!                  ***  ROUTINE sbc_oce_alloc  *** 
     87      !!--------------------------------------------------------------------- 
     88      USE in_out_manager, ONLY: ctl_warn 
     89      IMPLICIT none 
     90      INTEGER :: sbc_oce_alloc 
     91      ! Local variables 
     92      INTEGER :: ierr(4) 
     93      !!--------------------------------------------------------------------- 
     94 
     95      ierr(:) = 0 
     96 
     97      ALLOCATE(utau(jpi,jpj),    utau_b(jpi,jpj),                      & 
     98               vtau(jpi,jpj),    vtau_b(jpi,jpj),                      & 
     99               taum(jpi,jpj),    wndm(jpi,jpj)  , Stat=ierr(1))  
     100 
     101      ALLOCATE(qsr(jpi,jpj),     qns(jpi,jpj),    qns_b(jpi,jpj),      & 
     102               qsr_tot(jpi,jpj), qns_tot(jpi,jpj),                     & 
     103               emp(jpi,jpj),     emp_b(jpi,jpj),                       & 
     104               emps(jpi,jpj),    emps_b(jpi,jpj), emp_tot(jpi,jpj),    & 
     105               Stat=ierr(2)) 
     106 
     107      ALLOCATE(rnf(jpi,jpj),          rnf_b(jpi,jpj),                       & 
     108               sbc_tsc(jpi,jpj,jpts), sbc_tsc_b(jpi,jpj,jpts),         &   
     109               qsr_hc(jpi,jpj,jpk) ,  qsr_hc_b(jpi,jpj,jpk),  Stat=ierr(3)) 
     110 
     111      ALLOCATE(tprecip(jpi,jpj),      sprecip(jpi,jpj), fr_i(jpi,jpj), & 
     112#if defined key_cpl_carbon_cycle 
     113               atm_co2(jpi,jpj),                                       & 
     114#endif 
     115               ssu_m(jpi,jpj), ssv_m(jpi,jpj), sst_m(jpi,jpj),         & 
     116               sss_m(jpi,jpj), ssh_m(jpi,jpj), Stat=ierr(4)) 
     117 
     118      sbc_oce_alloc = MAXVAL(ierr) 
     119 
     120      IF(sbc_oce_alloc > 0)THEN 
     121         CALL ctl_warn('sbc_oce_alloc: allocation of arrays failed.') 
     122      END IF 
     123 
     124   END FUNCTION sbc_oce_alloc 
     125 
     126 
     127   SUBROUTINE sbc_tau2wnd 
     128      !!--------------------------------------------------------------------- 
     129      !!                    ***  ROUTINE sbc_tau2wnd  *** 
     130      !!                    
     131      !! ** Purpose : Estimation of wind speed as a function of wind stress    
     132      !! 
     133      !! ** Method  : |tau|=rhoa*Cd*|U|^2 
     134      !!--------------------------------------------------------------------- 
     135      USE dom_oce         ! ocean space and time domain 
     136      USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     137      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3 
     138      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient 
     139      REAL(wp) ::   ztx, zty, ztau, zcoef ! temporary variables 
     140      INTEGER  ::   ji, jj                ! dummy indices 
     141      !! * Substitutions 
     142#  include "vectopt_loop_substitute.h90" 
     143      !!--------------------------------------------------------------------- 
     144      zcoef = 0.5 / ( zrhoa * zcdrag )  
     145!CDIR NOVERRCHK 
     146      DO jj = 2, jpjm1 
     147!CDIR NOVERRCHK 
     148         DO ji = fs_2, fs_jpim1   ! vect. opt. 
     149            ztx = utau(ji-1,jj  ) + utau(ji,jj)  
     150            zty = vtau(ji  ,jj-1) + vtau(ji,jj)  
     151            ztau = SQRT( ztx * ztx + zty * zty ) 
     152            wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1) 
     153         END DO 
     154      END DO 
     155      CALL lbc_lnk( wndm(:,:) , 'T', 1. ) 
     156 
     157   END SUBROUTINE sbc_tau2wnd 
     158 
    80159END MODULE sbc_oce 

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

    r2528 r2590  
    4343   PUBLIC sbc_blk_clio        ! routine called by sbcmod.F90  
    4444   PUBLIC blk_ice_clio        ! routine called by sbcice_lim.F90  
     45   PUBLIC sbc_blk_clio_alloc  ! routine called by nemogcm.F90 
    4546 
    4647   INTEGER , PARAMETER ::   jpfld   = 7           ! maximum number of files to read  
    … …  
    5253   INTEGER , PARAMETER ::   jp_tair = 6           ! index of 10m air temperature             (Kelvin) 
    5354   INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s) 
    54    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read) 
     55   TYPE(FLD),ALLOCATABLE,SAVE,DIMENSION(:) :: sf  ! structure of input fields (file informations, fields read) 
    5556 
    5657   INTEGER, PARAMETER  ::   jpintsr = 24          ! number of time step between sunrise and sunset 
    … …  
    7374      &         6.6, 6.1, 5.6, 5.5, 5.8, 5.8, 5.6, 5.6, 5.6, 5.6 / 
    7475   !! 
    75    REAL(wp), DIMENSION(jpi,jpj) ::   sbudyko      ! cloudiness effect on LW radiation 
    76    REAL(wp), DIMENSION(jpi,jpj) ::   stauc        ! cloud optical depth  
     76   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sbudyko      ! cloudiness effect on LW radiation 
     77   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stauc        ! cloud optical depth  
    7778    
    7879   REAL(wp)  ::   zeps    = 1.e-20                ! constant values 
    … …  
    8788   !!---------------------------------------------------------------------- 
    8889CONTAINS 
     90 
     91   FUNCTION sbc_blk_clio_alloc() 
     92      !!--------------------------------------------------------------------- 
     93      !!                 ***  ROUTINE sbc_blk_clio_alloc  *** 
     94      !!--------------------------------------------------------------------- 
     95      IMPLICIT none 
     96      INTEGER :: sbc_blk_clio_alloc 
     97      !!--------------------------------------------------------------------- 
     98 
     99      ALLOCATE(sbudyko(jpi,jpj), & 
     100               stauc(jpi,jpj),   & 
     101               Stat=sbc_blk_clio_alloc) 
     102 
     103   END FUNCTION sbc_blk_clio_alloc 
    89104 
    90105   SUBROUTINE sbc_blk_clio( kt ) 
    … …  
    208223      !!  ** Nota    :   sf has to be a dummy argument for AGRIF on NEC 
    209224      !!---------------------------------------------------------------------- 
     225      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     226      USE wrk_nemo, ONLY: zqlw => wrk_2d_1  ! long-wave heat flux over ocean 
     227      USE wrk_nemo, ONLY: zqla => wrk_2d_2  ! latent heat flux over ocean 
     228      USE wrk_nemo, ONLY: zqsb => wrk_2d_3  ! sensible heat flux over ocean 
     229      !! 
    210230      TYPE(fld), INTENT(in), DIMENSION(:)       ::   sf    ! input data 
    211231      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pst   ! surface temperature                      [Celcius] 
    … …  
    223243      REAL(wp) ::   zrhoa, zev, zes, zeso, zqatm, zevsqr        !    -         - 
    224244      REAL(wp) ::   ztx2, zty2                                  !    -         - 
    225       !! 
    226       REAL(wp), DIMENSION(jpi,jpj) ::   zqlw        ! long-wave heat flux over ocean 
    227       REAL(wp), DIMENSION(jpi,jpj) ::   zqla        ! latent heat flux over ocean 
    228       REAL(wp), DIMENSION(jpi,jpj) ::   zqsb        ! sensible heat flux over ocean 
    229245      !!--------------------------------------------------------------------- 
     246 
     247      IF(.not. wrk_use(3, 1,2,3))THEN 
     248         CALL ctl_stop('blk_oce_clio: requested workspace arrays are unavailable.') 
     249         RETURN 
     250      END IF 
    230251 
    231252      zpatm = 101000.      ! atmospheric pressure  (assumed constant here) 
    … …  
    378399      ENDIF 
    379400 
     401      IF(.not. wrk_release(3, 1,2,3))THEN 
     402         CALL ctl_stop('blk_oce_clio: failed to release workspace arrays.') 
     403      END IF 
     404 
    380405   END SUBROUTINE blk_oce_clio 
    381406 
    … …  
    408433      !! 
    409434      !!---------------------------------------------------------------------- 
     435      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     436      USE wrk_nemo, ONLY:  ztatm => wrk_2d_1   ! Tair in Kelvin 
     437      USE wrk_nemo, ONLY:  zqatm => wrk_2d_2   ! specific humidity 
     438      USE wrk_nemo, ONLY: zevsqr => wrk_2d_3   ! vapour pressure square-root 
     439      USE wrk_nemo, ONLY:  zrhoa => wrk_2d_4   ! air density 
     440      USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2 
     441      !! 
    410442      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin] 
    411443      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [%] 
    … …  
    435467      REAL(wp) ::   ztice3, zticemb, zticemb2, zdqlw, zdqsb     !    -         - 
    436468      !! 
    437       REAL(wp), DIMENSION(jpi,jpj) ::   ztatm   ! Tair in Kelvin 
    438       REAL(wp), DIMENSION(jpi,jpj) ::   zqatm   ! specific humidity 
    439       REAL(wp), DIMENSION(jpi,jpj) ::   zevsqr  ! vapour pressure square-root 
    440       REAL(wp), DIMENSION(jpi,jpj) ::   zrhoa   ! air density 
    441       REAL(wp), DIMENSION(jpi,jpj,pdim) ::   z_qlw, z_qsb 
     469      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw, z_qsb 
    442470      !!--------------------------------------------------------------------- 
     471 
     472      IF( (.NOT. wrk_use(2, 1,2,3,4)) .OR. (.NOT. wrk_use(3, 1,2)) )THEN 
     473         CALL ctl_stop('blk_ice_clio: requested workspace arrays are unavailable.') 
     474         RETURN 
     475      ELSE IF(pdim > jpk)THEN 
     476         CALL ctl_stop('blk_ice_clio: too many ice levels to use wrk_nemo 3D workspaces.') 
     477         RETURN 
     478      END IF 
     479      z_qlw => wrk_3d_1(:,:,1:pdim) 
     480      z_qsb => wrk_3d_2(:,:,1:pdim) 
    443481 
    444482      ijpl  = pdim                           ! number of ice categories 
    … …  
    612650      ENDIF 
    613651 
     652      IF( (.NOT. wrk_release(2, 1,2,3,4)) .OR. (.NOT. wrk_release(3, 1,2)) )THEN 
     653         CALL ctl_stop('blk_ice_clio: failed to release workspace arrays.') 
     654      END IF 
    614655 
    615656   END SUBROUTINE blk_ice_clio 
    … …  
    626667      !!               - also initialise sbudyko and stauc once for all  
    627668      !!---------------------------------------------------------------------- 
     669      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     670      USE wrk_nemo, ONLY:   zev => wrk_2d_1                  ! vapour pressure 
     671      USE wrk_nemo, ONLY: zdlha => wrk_2d_2, zlsrise => wrk_2d_3, zlsset => wrk_2d_4  
     672      USE wrk_nemo, ONLY:   zps => wrk_2d_5, zpc => wrk_2d_6 ! sine (cosine) of latitude per sine (cosine) of solar declination  
     673      !! 
    628674      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)     ::   pqsr_oce    ! shortwave radiation  over the ocean 
    629675      !! 
    … …  
    644690      REAL(wp) ::   zxday, zdist, zcoef, zcoef1      ! 
    645691      REAL(wp) ::   zes 
    646       !! 
    647       REAL(wp), DIMENSION(jpi,jpj) ::   zev          ! vapour pressure 
    648       REAL(wp), DIMENSION(jpi,jpj) ::   zdlha, zlsrise, zlsset     ! 2D workspace 
    649  
    650       REAL(wp), DIMENSION(jpi,jpj) ::   zps, zpc   ! sine (cosine) of latitude per sine (cosine) of solar declination  
    651692      !!--------------------------------------------------------------------- 
    652693 
     694      IF(.NOT. wrk_use(2, 1,2,3,4,5,6))THEN 
     695         CALL ctl_stop('blk_clio_qsr_oce: requested workspace arrays unavailable.') 
     696         RETURN 
     697      END IF 
    653698 
    654699      IF( lbulk_init ) THEN             !   Initilization at first time step only 
    … …  
    764809      END DO 
    765810 
     811      IF(.NOT. wrk_release(2, 1,2,3,4,5,6))THEN 
     812         CALL ctl_stop('blk_clio_qsr_oce: failed to release workspace arrays.') 
     813      END IF 
     814 
    766815   END SUBROUTINE blk_clio_qsr_oce 
    767816 
    … …  
    777826      !!               - also initialise sbudyko and stauc once for all  
    778827      !!---------------------------------------------------------------------- 
     828      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     829      USE wrk_nemo, ONLY: zev => wrk_2d_1         ! vapour pressure 
     830      USE wrk_nemo, ONLY: zdlha => wrk_2d_2       ! 2D workspace 
     831      USE wrk_nemo, ONLY: zlsrise => wrk_2d_3     ! 2D workspace 
     832      USE wrk_nemo, ONLY: zlsset => wrk_2d_4      ! 2D workspace 
     833      USE wrk_nemo, ONLY: zps => wrk_2d_5, zpc => wrk_2d_6   ! sine (cosine) of latitude per sine (cosine) of solar declination  
     834      !! 
    779835      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pa_ice_cs   ! albedo of ice under clear sky 
    780836      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pa_ice_os   ! albedo of ice under overcast sky 
    … …  
    794850      REAL(wp) ::   zxday, zdist, zcoef, zcoef1   !    -         - 
    795851      REAL(wp) ::   zqsr_ice_cs, zqsr_ice_os      !    -         - 
    796       !! 
    797       REAL(wp), DIMENSION(jpi,jpj) ::   zev                      ! vapour pressure 
    798       REAL(wp), DIMENSION(jpi,jpj) ::   zdlha, zlsrise, zlsset   ! 2D workspace 
    799       REAL(wp), DIMENSION(jpi,jpj) ::   zps, zpc   ! sine (cosine) of latitude per sine (cosine) of solar declination  
    800852      !!--------------------------------------------------------------------- 
     853 
     854      IF(.NOT. wrk_use(2, 1,2,3,4,5,6))THEN 
     855         CALL ctl_stop('blk_clio_qsr_ice: requested workspace arrays unavailable.') 
     856         RETURN 
     857      END IF 
    801858 
    802859      ijpl = SIZE(pqsr_ice, 3 )      ! number of ice categories 
    … …  
    901958      END DO 
    902959      ! 
     960      IF(.NOT. wrk_release(2, 1,2,3,4,5,6))THEN 
     961         CALL ctl_stop('blk_clio_qsr_ice: failed to release workspace arrays.') 
     962      END IF 
     963      ! 
    903964   END SUBROUTINE blk_clio_qsr_ice 
    904965 

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

    r2528 r2590  
    4040   PRIVATE 
    4141 
    42    PUBLIC   sbc_blk_core       ! routine called in sbcmod module 
    43    PUBLIC   blk_ice_core       ! routine called in sbc_ice_lim module 
    44        
     42   PUBLIC   sbc_blk_core         ! routine called in sbcmod module 
     43   PUBLIC   blk_ice_core         ! routine called in sbc_ice_lim module 
     44 
    4545   INTEGER , PARAMETER ::   jpfld   = 9           ! maximum number of files to read  
    4646   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point 
    … …  
    7878   !!---------------------------------------------------------------------- 
    7979CONTAINS 
     80 
    8081 
    8182   SUBROUTINE sbc_blk_core( kt ) 
    … …  
    210211      !!  ** Nota  :   sf has to be a dummy argument for AGRIF on NEC 
    211212      !!--------------------------------------------------------------------- 
     213      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     214      USE wrk_nemo, ONLY: zwnd_i => wrk_2d_1, zwnd_j  => wrk_2d_2   ! wind speed components at T-point 
     215      USE wrk_nemo, ONLY: zqsatw => wrk_2d_3           ! specific humidity at pst 
     216      USE wrk_nemo, ONLY: zqlw => wrk_2d_4, zqsb => wrk_2d_5       ! long wave and sensible heat fluxes 
     217      USE wrk_nemo, ONLY: zqla => wrk_2d_6, zevap => wrk_2d_7      ! latent heat fluxes and evaporation 
     218      USE wrk_nemo, ONLY:    Cd => wrk_2d_8           ! transfer coefficient for momentum      (tau) 
     219      USE wrk_nemo, ONLY:    Ch => wrk_2d_9           ! transfer coefficient for sensible heat (Q_sens) 
     220      USE wrk_nemo, ONLY:    Ce => wrk_2d_10          ! transfer coefficient for evaporation   (Q_lat) 
     221      USE wrk_nemo, ONLY:   zst => wrk_2d_11          ! surface temperature in Kelvin 
     222      USE wrk_nemo, ONLY: zt_zu => wrk_2d_12          ! air temperature at wind speed height 
     223      USE wrk_nemo, ONLY: zq_zu => wrk_2d_13          ! air spec. hum.  at wind speed height 
     224      !! 
    212225      TYPE(fld), INTENT(in), DIMENSION(:)       ::   sf    ! input data 
    213       REAL(wp),  INTENT(in), DIMENSION(jpi,jpj) ::   pst   ! surface temperature                      [Celcius] 
    214       REAL(wp),  INTENT(in), DIMENSION(jpi,jpj) ::   pu    ! surface current at U-point (i-component) [m/s] 
    215       REAL(wp),  INTENT(in), DIMENSION(jpi,jpj) ::   pv    ! surface current at V-point (j-component) [m/s] 
     226      REAL(wp),  INTENT(in), DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius] 
     227      REAL(wp),  INTENT(in), DIMENSION(:,:) ::   pu    ! surface current at U-point (i-component) [m/s] 
     228      REAL(wp),  INTENT(in), DIMENSION(:,:) ::   pv    ! surface current at V-point (j-component) [m/s] 
    216229 
    217230      INTEGER  ::   ji, jj     ! dummy loop indices 
    218231      REAL(wp) ::   zcoef_qsatw 
    219232      REAL(wp) ::   zztmp                                 ! temporary variable 
    220       REAL(wp), DIMENSION(jpi,jpj) ::   zwnd_i, zwnd_j    ! wind speed components at T-point 
    221       REAL(wp), DIMENSION(jpi,jpj) ::   zqsatw            ! specific humidity at pst 
    222       REAL(wp), DIMENSION(jpi,jpj) ::   zqlw, zqsb        ! long wave and sensible heat fluxes 
    223       REAL(wp), DIMENSION(jpi,jpj) ::   zqla, zevap       ! latent heat fluxes and evaporation 
    224       REAL(wp), DIMENSION(jpi,jpj) ::   Cd                ! transfer coefficient for momentum      (tau) 
    225       REAL(wp), DIMENSION(jpi,jpj) ::   Ch                ! transfer coefficient for sensible heat (Q_sens) 
    226       REAL(wp), DIMENSION(jpi,jpj) ::   Ce                ! tansfert coefficient for evaporation   (Q_lat) 
    227       REAL(wp), DIMENSION(jpi,jpj) ::   zst               ! surface temperature in Kelvin 
    228       REAL(wp), DIMENSION(jpi,jpj) ::   zt_zu             ! air temperature at wind speed height 
    229       REAL(wp), DIMENSION(jpi,jpj) ::   zq_zu             ! air spec. hum.  at wind speed height 
    230233      !!--------------------------------------------------------------------- 
    231234 
     235      IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13))THEN 
     236         CALL ctl_stop('blk_oce_core: requested workspace arrays unavailable.') 
     237         RETURN 
     238      END IF 
     239      ! 
    232240      ! local scalars ( place there for vector optimisation purposes) 
    233241      zcoef_qsatw = 0.98 * 640380. / rhoa 
    … …  
    293301!            &                    Cd    (:,:),             Ch  (:,:), Ce  (:,:)  ) 
    294302!gm bug 
    295          CALL TURB_CORE_1Z( 10., zst   , sf(jp_tair)%fnow,         & 
    296             &                    zqsatw, sf(jp_humi)%fnow, wndm,   & 
     303! ARPDBG - this won't compile with gfortran. Fix but check performance 
     304! as per comment above. 
     305         CALL TURB_CORE_1Z( 10., zst   , sf(jp_tair)%fnow(:,:,1),       & 
     306            &                    zqsatw, sf(jp_humi)%fnow(:,:,1), wndm, & 
    297307            &                    Cd    , Ch              , Ce    ) 
    298308      ENDIF 
    … …  
    376386      ENDIF 
    377387      ! 
     388      IF(.NOT. wrk_release(2, 1,2,3,4,5,6,7,8,9,10,11,12,13))THEN 
     389         CALL ctl_stop('blk_oce_core: failed to release workspace arrays.') 
     390      END IF 
     391      ! 
    378392   END SUBROUTINE blk_oce_core 
    379393    
    … …  
    396410      !! caution : the net upward water flux has with mm/day unit 
    397411      !!--------------------------------------------------------------------- 
     412      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     413      USE wrk_nemo, ONLY: z_wnds_t => wrk_2d_1                ! wind speed ( = | U10m - U_ice | ) at T-point 
     414      USE wrk_nemo, ONLY: wrk_3d_4, wrk_3d_5, wrk_3d_6, wrk_3d_7 
     415      !! 
    398416      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pst      ! ice surface temperature (>0, =rt0 over land) [Kelvin] 
    399       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s] 
    400       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid) 
     417      REAL(wp), DIMENSION(:,:)    , INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s] 
     418      REAL(wp), DIMENSION(:,:)    , INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid) 
    401419      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   palb     ! ice albedo (clear sky) (alb_ice_cs)               [%] 
    402       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2] 
    403       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid) 
     420      REAL(wp), DIMENSION(:,:)    , INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2] 
     421      REAL(wp), DIMENSION(:,:)    , INTENT(  out) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid) 
    404422      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   p_qns    ! non solar heat flux over ice (T-point)         [W/m2] 
    405423      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   p_qsr    !     solar heat flux over ice (T-point)         [W/m2] 
    … …  
    407425      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   p_dqns   ! non solar heat sensistivity  (T-point)         [W/m2] 
    408426      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   p_dqla   ! latent    heat sensistivity  (T-point)         [W/m2] 
    409       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_tpr    ! total precipitation          (T-point)      [Kg/m2/s] 
    410       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_spr    ! solid precipitation          (T-point)      [Kg/m2/s] 
    411       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_fr1    ! 1sr fraction of qsr penetration in ice (T-point)  [%] 
    412       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_fr2    ! 2nd fraction of qsr penetration in ice (T-point)  [%] 
     427      REAL(wp), DIMENSION(:,:)    , INTENT(  out) ::   p_tpr    ! total precipitation          (T-point)      [Kg/m2/s] 
     428      REAL(wp), DIMENSION(:,:),    INTENT(  out) ::   p_spr    ! solid precipitation          (T-point)      [Kg/m2/s] 
     429      REAL(wp), DIMENSION(:,:),    INTENT(  out) ::   p_fr1    ! 1sr fraction of qsr penetration in ice (T-point)  [%] 
     430      REAL(wp), DIMENSION(:,:),    INTENT(  out) ::   p_fr2    ! 2nd fraction of qsr penetration in ice (T-point)  [%] 
    413431      CHARACTER(len=1)            , INTENT(in   ) ::   cd_grid  ! ice grid ( C or B-grid) 
    414432      INTEGER                     , INTENT(in   ) ::   pdim     ! number of ice categories 
    … …  
    422440      REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f                  ! relative wind module and components at F-point 
    423441      REAL(wp) ::             zwndi_t , zwndj_t                  ! relative wind components at T-point 
    424       REAL(wp), DIMENSION(jpi,jpj) ::   z_wnds_t                 ! wind speed ( = | U10m - U_ice | ) at T-point 
    425       REAL(wp), DIMENSION(jpi,jpj,pdim) ::   z_qlw               ! long wave heat flux over ice 
    426       REAL(wp), DIMENSION(jpi,jpj,pdim) ::   z_qsb               ! sensible  heat flux over ice 
    427       REAL(wp), DIMENSION(jpi,jpj,pdim) ::   z_dqlw              ! long wave heat sensitivity over ice 
    428       REAL(wp), DIMENSION(jpi,jpj,pdim) ::   z_dqsb              ! sensible  heat sensitivity over ice 
     442      !! 
     443      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice 
     444      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb             ! sensible  heat flux over ice 
     445      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw            ! long wave heat sensitivity over ice 
     446      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice 
    429447      !!--------------------------------------------------------------------- 
    430448 
    431449      ijpl  = pdim                            ! number of ice categories 
     450 
     451      ! Set-up access to workspace arrays 
     452      IF( (.NOT. wrk_use(2, 1)) .OR. (.NOT. wrk_use(3, 4,5,6,7)) )THEN 
     453         CALL ctl_stop('blk_ice_core: requested workspace arrays unavailable.') 
     454         RETURN 
     455      ELSE IF(ijpl > jpk)THEN 
     456         CALL ctl_stop('blk_ice_core: no. of ice categories > jpk so wrk_nemo 3D workspaces cannot be used.') 
     457         RETURN 
     458      END IF 
     459      ! Set-up pointers to sub-arrays of workspaces 
     460      z_qlw  => wrk_3d_4(:,:,1:ijpl) 
     461      z_qsb  => wrk_3d_5(:,:,1:ijpl) 
     462      z_dqlw => wrk_3d_6(:,:,1:ijpl) 
     463      z_dqsb => wrk_3d_7(:,:,1:ijpl) 
    432464 
    433465      ! local scalars ( place there for vector optimisation purposes) 
    … …  
    579611      ENDIF 
    580612 
     613      IF( (.NOT. wrk_release(2, 1)) .OR. (.NOT. wrk_release(3, 4,5,6,7)) )THEN 
     614         CALL ctl_stop('blk_ice_core: failed to release workspace arrays.') 
     615      END IF 
     616 
    581617   END SUBROUTINE blk_ice_core 
    582618   
    … …  
    602638      !!   9.0  !  05-08  (L. Brodeau) Rewriting and optimization 
    603639      !!---------------------------------------------------------------------- 
     640      USE wrk_nemo, ONLY: wrk_use, wrk_release, iwrk_use, iwrk_release 
     641      USE wrk_nemo, ONLY: dU10 => wrk_2d_14        ! dU                             [m/s] 
     642      USE wrk_nemo, ONLY: dT => wrk_2d_15          ! air/sea temperature difference   [K] 
     643      USE wrk_nemo, ONLY: dq => wrk_2d_16          ! air/sea humidity difference      [K] 
     644      USE wrk_nemo, ONLY: Cd_n10 => wrk_2d_17      ! 10m neutral drag coefficient 
     645      USE wrk_nemo, ONLY: Ce_n10 => wrk_2d_18      ! 10m neutral latent coefficient 
     646      USE wrk_nemo, ONLY: Ch_n10 => wrk_2d_19      ! 10m neutral sensible coefficient 
     647      USE wrk_nemo, ONLY: sqrt_Cd_n10 => wrk_2d_20 ! root square of Cd_n10 
     648      USE wrk_nemo, ONLY: sqrt_Cd => wrk_2d_21     ! root square of Cd 
     649      USE wrk_nemo, ONLY: T_vpot => wrk_2d_22      ! virtual potential temperature    [K] 
     650      USE wrk_nemo, ONLY: T_star => wrk_2d_23      ! turbulent scale of tem. fluct. 
     651      USE wrk_nemo, ONLY: q_star => wrk_2d_24      ! turbulent humidity of temp. fluct. 
     652      USE wrk_nemo, ONLY: U_star => wrk_2d_25      ! turb. scale of velocity fluct. 
     653      USE wrk_nemo, ONLY: L => wrk_2d_26           ! Monin-Obukov length              [m] 
     654      USE wrk_nemo, ONLY: zeta => wrk_2d_27        ! stability parameter at height zu 
     655      USE wrk_nemo, ONLY: U_n10 => wrk_2d_28       ! neutral wind velocity at 10m     [m] 
     656      USE wrk_nemo, ONLY: xlogt => wrk_2d_29,    xct => wrk_2d_30,   & 
     657                         zpsi_h => wrk_2d_31, zpsi_m => wrk_2d_32 
     658      USE wrk_nemo, ONLY: stab => iwrk_2d_1      ! 1st guess stability test integer 
     659      !! 
    604660      REAL(wp), INTENT(in) :: zu                 ! altitude of wind measurement       [m] 
    605       REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::  & 
     661      REAL(wp), INTENT(in),  DIMENSION(:,:) ::  & 
    606662         sst,       &       ! sea surface temperature         [Kelvin] 
    607663         T_a,       &       ! potential air temperature       [Kelvin] 
    … …  
    609665         q_a,       &       ! specific air humidity           [kg/kg] 
    610666         dU                 ! wind module |U(zu)-U(0)|        [m/s] 
    611       REAL(wp), intent(out), DIMENSION(jpi,jpj) :: & 
     667      REAL(wp), intent(out), DIMENSION(:,:) :: & 
    612668         Cd,    &                ! transfert coefficient for momentum       (tau) 
    613669         Ch,    &                ! transfert coefficient for temperature (Q_sens) 
    614670         Ce                      ! transfert coefficient for evaporation  (Q_lat) 
    615  
    616       !! * Local declarations 
    617       REAL(wp), DIMENSION(jpi,jpj)  ::   & 
    618          dU10,        &       ! dU                                   [m/s] 
    619          dT,          &       ! air/sea temperature differeence      [K] 
    620          dq,          &       ! air/sea humidity difference          [K] 
    621          Cd_n10,      &       ! 10m neutral drag coefficient 
    622          Ce_n10,      &       ! 10m neutral latent coefficient 
    623          Ch_n10,      &       ! 10m neutral sensible coefficient 
    624          sqrt_Cd_n10, &       ! root square of Cd_n10 
    625          sqrt_Cd,     &       ! root square of Cd 
    626          T_vpot,      &       ! virtual potential temperature        [K] 
    627          T_star,      &       ! turbulent scale of tem. fluct. 
    628          q_star,      &       ! turbulent humidity of temp. fluct. 
    629          U_star,      &       ! turb. scale of velocity fluct. 
    630          L,           &       ! Monin-Obukov length                  [m] 
    631          zeta,        &       ! stability parameter at height zu 
    632          U_n10,       &       ! neutral wind velocity at 10m         [m]    
    633          xlogt, xct, zpsi_h, zpsi_m 
    634671      !! 
    635672      INTEGER :: j_itt 
    636673      INTEGER, PARAMETER :: nb_itt = 3 
    637       INTEGER, DIMENSION(jpi,jpj)  ::   & 
    638          stab         ! 1st guess stability test integer 
    639674 
    640675      REAL(wp), PARAMETER ::                        & 
    … …  
    642677         kappa  = 0.4              ! von Karman s constant 
    643678      !!---------------------------------------------------------------------- 
     679 
     680      IF( (.NOT. wrk_use(2, 14,15,16,17,18,       & 
     681                         19,20,21,22,23,24,       & 
     682                         25,26,27,28,29,30,       & 
     683                         31,32))             .OR. & 
     684          (.NOT. iwrk_use(2, 1)) )THEN 
     685         CALL ctl_stop('TURB_CORE_1Z: requested workspace arrays unavailable.') 
     686         RETURN 
     687      END IF 
     688 
    644689      !! * Start 
    645690      !! Air/sea differences 
    … …  
    672717 
    673718         !! Stability parameters : 
    674          zeta = zu/L ;  zeta   = sign( min(abs(zeta),10.0), zeta ) 
    675          zpsi_h = psi_h(zeta) 
    676          zpsi_m = psi_m(zeta) 
     719         zeta  = zu/L ;  zeta   = sign( min(abs(zeta),10.0), zeta ) 
     720         zpsi_h  = psi_h(zeta) 
     721         zpsi_m  = psi_m(zeta) 
    677722 
    678723         !! Shifting the wind speed to 10m and neutral stability : 
    … …  
    701746      END DO 
    702747      !! 
     748      IF( (.NOT. wrk_release(2, 14,15,16,17,18,       & 
     749                             19,20,21,22,23,24,       & 
     750                             25,26,27,28,29,30,       & 
     751                             31,32))             .OR. & 
     752          (.NOT. iwrk_release(2, 1)) )THEN 
     753         CALL ctl_stop('TURB_CORE_1Z: failed to release workspace arrays.') 
     754      END IF 
     755      !! 
    703756    END SUBROUTINE TURB_CORE_1Z 
    704757 
    … …  
    722775      !!   9.0  !  06-12  (L. Brodeau) Original code for 2Z 
    723776      !!---------------------------------------------------------------------- 
     777      USE wrk_nemo, ONLY: wrk_use, wrk_release, iwrk_use, iwrk_release 
     778      USE wrk_nemo, ONLY: dU10 => wrk_2d_1        ! dU                             [m/s] 
     779      USE wrk_nemo, ONLY: dT => wrk_2d_2          ! air/sea temperature difference   [K] 
     780      USE wrk_nemo, ONLY: dq => wrk_2d_3          ! air/sea humidity difference      [K] 
     781      USE wrk_nemo, ONLY: Cd_n10 => wrk_2d_4      ! 10m neutral drag coefficient 
     782      USE wrk_nemo, ONLY: Ce_n10 => wrk_2d_5      ! 10m neutral latent coefficient 
     783      USE wrk_nemo, ONLY: Ch_n10 => wrk_2d_6      ! 10m neutral sensible coefficient 
     784      USE wrk_nemo, ONLY: sqrt_Cd_n10 => wrk_2d_7 ! root square of Cd_n10 
     785      USE wrk_nemo, ONLY: sqrt_Cd => wrk_2d_8     ! root square of Cd 
     786      USE wrk_nemo, ONLY: T_vpot => wrk_2d_9      ! virtual potential temperature    [K] 
     787      USE wrk_nemo, ONLY: T_star => wrk_2d_10     ! turbulent scale of tem. fluct. 
     788      USE wrk_nemo, ONLY: q_star => wrk_2d_11     ! turbulent humidity of temp. fluct. 
     789      USE wrk_nemo, ONLY: U_star => wrk_2d_12     ! turb. scale of velocity fluct. 
     790      USE wrk_nemo, ONLY: L => wrk_2d_13          ! Monin-Obukov length              [m] 
     791      USE wrk_nemo, ONLY: zeta_u => wrk_2d_14     ! stability parameter at height zu 
     792      USE wrk_nemo, ONLY: zeta_t => wrk_2d_15     ! stability parameter at height zt 
     793      USE wrk_nemo, ONLY: U_n10 => wrk_2d_16      ! neutral wind velocity at 10m     [m] 
     794      USE wrk_nemo, ONLY: xlogt => wrk_2d_17, xct => wrk_2d_18, zpsi_hu => wrk_2d_19, zpsi_ht => wrk_2d_20, zpsi_m => wrk_2d_21 
     795      USE wrk_nemo, ONLY: stab => iwrk_2d_1      ! 1st guess stability test integer 
     796      !! 
    724797      REAL(wp), INTENT(in)   :: & 
    725798         zt,      &     ! height for T_zt and q_zt                   [m] 
    … …  
    738811         q_zu            ! spec. hum.  shifted at zu               [kg/kg] 
    739812 
    740       !! * Local declarations 
    741       REAL(wp), DIMENSION(jpi,jpj) ::  & 
    742          dU10,        &     ! dU                                [m/s] 
    743          dT,          &     ! air/sea temperature differeence   [K] 
    744          dq,          &     ! air/sea humidity difference       [K] 
    745          Cd_n10,      &     ! 10m neutral drag coefficient 
    746          Ce_n10,      &     ! 10m neutral latent coefficient 
    747          Ch_n10,      &     ! 10m neutral sensible coefficient 
    748          sqrt_Cd_n10, &     ! root square of Cd_n10 
    749          sqrt_Cd,     &     ! root square of Cd 
    750          T_vpot_u,    &     ! virtual potential temperature        [K] 
    751          T_star,      &     ! turbulent scale of tem. fluct. 
    752          q_star,      &     ! turbulent humidity of temp. fluct. 
    753          U_star,      &     ! turb. scale of velocity fluct. 
    754          L,           &     ! Monin-Obukov length                  [m] 
    755          zeta_u,      &     ! stability parameter at height zu 
    756          zeta_t,      &     ! stability parameter at height zt 
    757          U_n10,       &     ! neutral wind velocity at 10m        [m] 
    758          xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m 
    759  
    760813      INTEGER :: j_itt 
    761814      INTEGER, PARAMETER :: nb_itt = 3   ! number of itterations 
    762       INTEGER, DIMENSION(jpi,jpj) :: & 
    763            &     stab                ! 1st stability test integer 
    764815      REAL(wp), PARAMETER ::                        & 
    765816         grav   = 9.8,      &  ! gravity                        
    … …  
    767818      !!---------------------------------------------------------------------- 
    768819      !!  * Start 
     820 
     821      IF( (.NOT. wrk_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21)) .OR. & 
     822          (.NOT. iwrk_use(2, 1)) )THEN 
     823         CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable.') 
     824         RETURN 
     825      END IF 
    769826 
    770827      !! Initial air/sea differences 
    … …  
    789846      DO j_itt=1, nb_itt 
    790847         dT = T_zu - sst ;  dq = q_zu - q_sat ! Updating air/sea differences 
    791          T_vpot_u = T_zu*(1. + 0.608*q_zu)    ! Updating virtual potential temperature at zu 
     848         T_vpot = T_zu*(1. + 0.608*q_zu)    ! Updating virtual potential temperature at zu 
    792849         U_star = sqrt_Cd*dU10                ! Updating turbulent scales :   (L & Y eq. (7)) 
    793850         T_star  = Ch/sqrt_Cd*dT              ! 
    … …  
    795852         !! 
    796853         L = (U_star*U_star) &                ! Estimate the Monin-Obukov length at height zu 
    797               & / (kappa*grav/T_vpot_u*(T_star*(1.+0.608*q_zu) + 0.608*T_zu*q_star)) 
     854              & / (kappa*grav/T_vpot*(T_star*(1.+0.608*q_zu) + 0.608*T_zu*q_star)) 
    798855         !! Stability parameters : 
    799856         zeta_u  = zu/L  ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u ) 
    … …  
    841898      END DO 
    842899      !! 
     900      IF( (.NOT. wrk_release(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21)) .OR. & 
     901          (.NOT. iwrk_release(2, 1)) )THEN 
     902         CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable.') 
     903      END IF 
     904 
    843905    END SUBROUTINE TURB_CORE_2Z 
    844906 
    845907 
    846908    FUNCTION psi_m(zta)   !! Psis, L & Y eq. (8c), (8d), (8e) 
     909      !------------------------------------------------------------------------------- 
     910      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     911      USE wrk_nemo, ONLY:     X2 => wrk_2d_33 
     912      USE wrk_nemo, ONLY:     X  => wrk_2d_34 
     913      USE wrk_nemo, ONLY: stabit => wrk_2d_35 
     914      !! 
    847915      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: zta 
    848916 
    849917      REAL(wp), PARAMETER :: pi = 3.141592653589793_wp 
    850918      REAL(wp), DIMENSION(jpi,jpj)             :: psi_m 
    851       REAL(wp), DIMENSION(jpi,jpj)             :: X2, X, stabit 
     919      !------------------------------------------------------------------------------- 
     920 
     921      IF(.NOT. wrk_use(2, 33,34,35))THEN 
     922         CALL ctl_stop('psi_m: requested workspace arrays unavailable.') 
     923         RETURN 
     924      END IF 
     925 
    852926      X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.0) ;  X  = sqrt(X2) 
    853927      stabit    = 0.5 + sign(0.5,zta) 
    854928      psi_m = -5.*zta*stabit  &                                                  ! Stable 
    855929           & + (1. - stabit)*(2*log((1. + X)/2) + log((1. + X2)/2) - 2*atan(X) + pi/2)  ! Unstable  
     930 
     931      IF(.NOT. wrk_release(2, 33,34,35))THEN 
     932         CALL ctl_stop('psi_m: failed to release workspace arrays.') 
     933         RETURN 
     934      END IF 
     935 
    856936    END FUNCTION psi_m 
    857937 
     938 
    858939    FUNCTION psi_h(zta)    !! Psis, L & Y eq. (8c), (8d), (8e) 
     940      !------------------------------------------------------------------------------- 
     941      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     942      USE wrk_nemo, ONLY:     X2 => wrk_2d_33 
     943      USE wrk_nemo, ONLY:     X  => wrk_2d_34 
     944      USE wrk_nemo, ONLY: stabit => wrk_2d_35 
     945      !! 
    859946      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: zta 
    860947 
    861948      REAL(wp), DIMENSION(jpi,jpj)             :: psi_h 
    862       REAL(wp), DIMENSION(jpi,jpj)             :: X2, X, stabit 
     949      !------------------------------------------------------------------------------- 
     950 
     951      IF(.NOT. wrk_use(2, 33,34,35))THEN 
     952         CALL ctl_stop('psi_h: requested workspace arrays unavailable.') 
     953         RETURN 
     954      END IF 
     955 
    863956      X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.) ;  X  = sqrt(X2) 
    864957      stabit    = 0.5 + sign(0.5,zta) 
    865958      psi_h = -5.*zta*stabit  &                                       ! Stable 
    866959           & + (1. - stabit)*(2.*log( (1. + X2)/2. ))                 ! Unstable 
     960 
     961      IF(.NOT. wrk_release(2, 33,34,35))THEN 
     962         CALL ctl_stop('psi_h: failed to release workspace arrays.') 
     963         RETURN 
     964      END IF 
     965 
    867966    END FUNCTION psi_h 
    868967   

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

    r2528 r2590  
    5454   PRIVATE 
    5555 
    56    PUBLIC   sbc_cpl_rcv       ! routine called by sbc_ice_lim(_2).F90 
    57    PUBLIC   sbc_cpl_snd       ! routine called by step.F90 
    58    PUBLIC   sbc_cpl_ice_tau   ! routine called by sbc_ice_lim(_2).F90 
    59    PUBLIC   sbc_cpl_ice_flx   ! routine called by sbc_ice_lim(_2).F90 
    60     
     56   PUBLIC   sbc_cpl_rcv        ! routine called by sbc_ice_lim(_2).F90 
     57   PUBLIC   sbc_cpl_snd        ! routine called by step.F90 
     58   PUBLIC   sbc_cpl_ice_tau    ! routine called by sbc_ice_lim(_2).F90 
     59   PUBLIC   sbc_cpl_ice_flx    ! routine called by sbc_ice_lim(_2).F90 
     60   PUBLIC   sbc_cpl_init_alloc ! routine called by nemogcm.F90 
     61 
    6162   INTEGER, PARAMETER ::   jpr_otx1   =  1            ! 3 atmosphere-ocean stress components on grid 1 
    6263   INTEGER, PARAMETER ::   jpr_oty1   =  2            !  
    … …  
    149150   CHARACTER(len=100), DIMENSION(4) ::   cn_rcv_tau           ! array combining cn_rcv_tau_* 
    150151 
    151    REAL(wp), DIMENSION(jpi,jpj)       ::   albedo_oce_mix     ! ocean albedo sent to atmosphere (mix clear/overcast sky) 
    152  
    153    REAL(wp), DIMENSION(jpi,jpj,jprcv) ::   frcv               ! all fields recieved from the atmosphere 
    154    INTEGER , DIMENSION(        jprcv) ::   nrcvinfo           ! OASIS info argument 
     152   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   albedo_oce_mix     ! ocean albedo sent to atmosphere (mix clear/overcast sky) 
     153 
     154   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   frcv               ! all fields recieved from the atmosphere 
     155   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument 
    155156 
    156157#if ! defined key_lim2 && ! defined key_lim3 
    157158   ! quick patch to be able to run the coupled model without sea-ice... 
    158159   INTEGER, PARAMETER               ::   jpl = 1  
    159    REAL(wp), DIMENSION(jpi,jpj    ) ::   hicif, hsnif, u_ice, v_ice,fr1_i0,fr2_i0 
    160    REAL(wp), DIMENSION(jpi,jpj,jpl) ::   tn_ice, alb_ice 
     160   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hicif, hsnif, u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 
     161   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice ! (jpi,jpj,jpl) 
    161162   REAL(wp)                         ::  lfus 
    162163#endif 
    … …  
    172173CONTAINS 
    173174   
     175   FUNCTION sbc_cpl_init_alloc() 
     176      !!---------------------------------------------------------------------- 
     177      !!             ***  ROUTINE sbc_cpl_init_alloc  *** 
     178      !!---------------------------------------------------------------------- 
     179      IMPLICIT none 
     180      INTEGER :: sbc_cpl_init_alloc 
     181      INTEGER :: ierr(2) 
     182      !!---------------------------------------------------------------------- 
     183 
     184      ierr(:) = 0 
     185 
     186      ALLOCATE(albedo_oce_mix(jpi,jpj), & 
     187               frcv(jpi,jpj,jprcv),     & 
     188               nrcvinfo(jprcv),  Stat=Stat=ierr(1)) 
     189 
     190#if ! defined key_lim2 && ! defined key_lim3 
     191      ! quick patch to be able to run the coupled model without sea-ice... 
     192      ALLOCATE(hicif(jpi,jpj), hsnif(jpi,jpj), u_ice(jpi,jpj),  & 
     193               v_ice(jpi,jpj), fr1_i0(jpi,jpj),fr2_i0(jpi,jpj), & 
     194               tn_ice(jpi,jpj,jpl), alb_ice(jpi,jpj,jpl),       & 
     195               Stat=ierr(2) ) 
     196#endif 
     197 
     198      sbc_cpl_init_alloc = MAXVAL(ierr) 
     199 
     200      IF(sbc_cpl_init_alloc > 0)THEN 
     201         CALL ctl_warn('sbc_cpl_init_alloc: allocation of arrays failed.') 
     202      END IF 
     203 
     204    END FUNCTION sbc_cpl_init_alloc 
     205 
    174206   SUBROUTINE sbc_cpl_init( k_ice )      
    175207      !!---------------------------------------------------------------------- 
    … …  
    184216      !!              * initialise the OASIS coupler 
    185217      !!---------------------------------------------------------------------- 
     218      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     219      USE wrk_nemo, ONLY: zacs => wrk_2d_1, zaos => wrk_2d_2 ! clear & overcast sky albedos 
     220      !! 
    186221      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
    187222      !! 
    188223      INTEGER                      ::   jn           ! dummy loop index 
    189       REAL(wp), DIMENSION(jpi,jpj) ::   zacs, zaos   ! 2D workspace (clear & overcast sky albedos) 
    190224      !! 
    191225      NAMELIST/namsbc_cpl/  cn_snd_temperature, cn_snd_albedo    , cn_snd_thickness,                 &           
    … …  
    198232#endif 
    199233      !!--------------------------------------------------------------------- 
     234 
     235      IF(.not. wrk_use(2,1,2))THEN 
     236         CALL ctl_stop('sbc_cpl_init: requested workspace arrays unavailable.') 
     237         RETURN 
     238      END IF 
    200239 
    201240      ! ================================ ! 
    … …  
    532571         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
    533572 
     573      IF(.not. wrk_release(2,1,2))THEN 
     574         CALL ctl_stop('sbc_cpl_init: failed to release workspace arrays.') 
     575      END IF 
     576 
    534577   END SUBROUTINE sbc_cpl_init 
    535578 
    … …  
    577620      !!                        emp = emps   evap. - precip. (- runoffs) (- calving) ('ocean only case) 
    578621      !!---------------------------------------------------------------------- 
     622      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     623      USE wrk_nemo, ONLY: ztx => wrk_2d_1, zty => wrk_2d_2 
     624      !! 
    579625      INTEGER, INTENT(in) ::   kt       ! ocean model time step index 
    580626      INTEGER, INTENT(in) ::   k_fsbc   ! frequency of sbc (-> ice model) computation  
    … …  
    589635      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    590636      REAL(wp) ::   zzx, zzy               ! temporary variables 
    591       REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty   ! 2D workspace  
    592       !!---------------------------------------------------------------------- 
     637      !!---------------------------------------------------------------------- 
     638 
     639      IF(.not. wrk_use(2, 1,2))THEN 
     640         CALL ctl_stop('sbc_cpl_rcv: requested workspace arrays unavailable.') 
     641         RETURN 
     642      END IF 
    593643 
    594644      IF( kt == nit000 )   CALL sbc_cpl_init( k_ice )          ! initialisation 
    … …  
    778828      ENDIF 
    779829      ! 
     830      IF(.not. wrk_release(2, 1,2))THEN 
     831         CALL ctl_stop('sbc_cpl_rcv: failed to release workspace arrays.') 
     832      END IF 
     833      ! 
    780834   END SUBROUTINE sbc_cpl_rcv 
    781835    
    … …  
    814868      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice at cp_ice_msh point 
    815869      !!---------------------------------------------------------------------- 
    816       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2] 
    817       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid) 
     870      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     871      USE wrk_nemo, ONLY: ztx => wrk_2d_1, zty => wrk_2d_2 
     872      !! 
     873      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2] 
     874      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid) 
    818875      !! 
    819876      INTEGER ::   ji, jj                          ! dummy loop indices 
    820877      INTEGER ::   itx                             ! index of taux over ice 
    821       REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty   ! 2D workspace 
    822       !!---------------------------------------------------------------------- 
     878      !!---------------------------------------------------------------------- 
     879 
     880      IF(.not. wrk_use(2,1,2))THEN 
     881         CALL ctl_stop('sbc_cpl_ice_tau: requested workspace arrays unavailable.') 
     882         RETURN 
     883      END IF 
    823884 
    824885      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
    … …  
    9881049      ENDIF 
    9891050      !    
     1051      IF(.not. wrk_release(2,1,2))THEN 
     1052         CALL ctl_stop('sbc_cpl_ice_tau: failed to release workspace arrays.') 
     1053      END IF 
     1054      ! 
    9901055   END SUBROUTINE sbc_cpl_ice_tau 
    9911056    
    … …  
    10361101      !!                   sprecip             solid precipitation over the ocean   
    10371102      !!---------------------------------------------------------------------- 
    1038       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpl) ::   p_frld     ! lead fraction                [0 to 1] 
    1039       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj    ) ::   pqns_tot   ! total non solar heat flux    [W/m2] 
    1040       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpl) ::   pqns_ice   ! ice   non solar heat flux    [W/m2] 
    1041       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj    ) ::   pqsr_tot   ! total     solar heat flux    [W/m2] 
    1042       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpl) ::   pqsr_ice   ! ice       solar heat flux    [W/m2] 
    1043       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj    ) ::   pemp_tot   ! total     freshwater budget        [Kg/m2/s] 
    1044       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj    ) ::   pemp_ice   ! solid freshwater budget over ice   [Kg/m2/s] 
    1045       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj    ) ::   psprecip   ! Net solid precipitation (=emp_ice) [Kg/m2/s] 
    1046       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpl) ::   pdqns_ice  ! d(Q non solar)/d(Temperature) over ice 
     1103      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     1104      USE wrk_nemo, ONLY: zcptn => wrk_2d_1  ! rcp * tn(:,:,1) 
     1105      USE wrk_nemo, ONLY: ztmp  => wrk_2d_2  ! temporary array 
     1106      USE wrk_nemo, ONLY: zsnow => wrk_2d_3  ! snow precipitation  
     1107      USE wrk_nemo, ONLY: zicefr => wrk_3d_1 ! ice fraction  
     1108      !! 
     1109      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   p_frld     ! lead fraction                [0 to 1] 
     1110      REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqns_tot   ! total non solar heat flux    [W/m2] 
     1111      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqns_ice   ! ice   non solar heat flux    [W/m2] 
     1112      REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqsr_tot   ! total     solar heat flux    [W/m2] 
     1113      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqsr_ice   ! ice       solar heat flux    [W/m2] 
     1114      REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_tot   ! total     freshwater budget        [Kg/m2/s] 
     1115      REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_ice   ! solid freshwater budget over ice   [Kg/m2/s] 
     1116      REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   psprecip   ! Net solid precipitation (=emp_ice) [Kg/m2/s] 
     1117      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pdqns_ice  ! d(Q non solar)/d(Temperature) over ice 
    10471118      ! optional arguments, used only in 'mixed oce-ice' case 
    1048       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpl), OPTIONAL ::   palbi   ! ice albedo  
    1049       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj    ), OPTIONAL ::   psst    ! sea surface temperature     [Celcius] 
    1050       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpl), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
    1051      !! 
     1119      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo  
     1120      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celcius] 
     1121      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
     1122      !! 
    10521123      INTEGER ::   ji, jj           ! dummy loop indices 
    10531124      INTEGER ::   isec, info       ! temporary integer 
    10541125      REAL(wp)::   zcoef, ztsurf    ! temporary scalar 
    1055       REAL(wp), DIMENSION(jpi,jpj    )::   zcptn    ! rcp * tn(:,:,1) 
    1056       REAL(wp), DIMENSION(jpi,jpj    )::   ztmp     ! temporary array 
    1057       REAL(wp), DIMENSION(jpi,jpj    )::   zsnow    ! snow precipitation  
    1058       REAL(wp), DIMENSION(jpi,jpj,jpl)::   zicefr   ! ice fraction  
    1059       !!---------------------------------------------------------------------- 
     1126      !!---------------------------------------------------------------------- 
     1127 
     1128      IF( (.not. wrk_use(2,1,2,3)) .OR. (.not. wrk_use(3,1)) )THEN 
     1129         CALL ctl_stop('sbc_cpl_ice_flx: requested workspace arrays unavailable.') 
     1130         RETURN 
     1131      END IF 
     1132 
    10601133      zicefr(:,:,1) = 1.- p_frld(:,:,1) 
    10611134      IF( lk_diaar5 )   zcptn(:,:) = rcp * tn(:,:,1) 
    … …  
    11751248      END SELECT 
    11761249 
     1250      IF( (.not. wrk_release(2,1,2,3)) .OR. (.not. wrk_release(3,1)) )THEN 
     1251         CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays.') 
     1252      END IF 
     1253 
    11771254   END SUBROUTINE sbc_cpl_ice_flx 
    11781255    
    … …  
    11871264      !!              all the needed fields (as defined in sbc_cpl_init) 
    11881265      !!---------------------------------------------------------------------- 
     1266      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     1267      USE wrk_nemo, ONLY: zfr_l => wrk_2d_1 ! 1. - fr_i(:,:) 
     1268      USE wrk_nemo, ONLY: ztmp1 => wrk_2d_2, ztmp2 => wrk_2d_3 
     1269      USE wrk_nemo, ONLY: zotx1=> wrk_2d_4, zoty1=> wrk_2d_5, zotz1=> wrk_2d_6 
     1270      USE wrk_nemo, ONLY: zitx1=> wrk_2d_7, zity1=> wrk_2d_8, zitz1=> wrk_2d_9 
     1271      !! 
    11891272      INTEGER, INTENT(in) ::   kt 
    11901273      !! 
    11911274      INTEGER ::   ji, jj          ! dummy loop indices 
    11921275      INTEGER ::   isec, info      ! temporary integer 
    1193       REAL(wp), DIMENSION(jpi,jpj) ::   zfr_l   ! 1. - fr_i(:,:) 
    1194       REAL(wp), DIMENSION(jpi,jpj) ::   ztmp1, ztmp2 
    1195       REAL(wp), DIMENSION(jpi,jpj) ::   zotx1 , zoty1 , zotz1, zitx1, zity1, zitz1 
    1196       !!---------------------------------------------------------------------- 
     1276      !!---------------------------------------------------------------------- 
     1277 
     1278      IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7,8,9))THEN 
     1279         CALL ctl_stop('sbc_cpl_snd: requested workspace arrays are unavailable.'); 
     1280         RETURN 
     1281      END IF 
    11971282 
    11981283      isec = ( kt - nit000 ) * NINT(rdttra(1))        ! date of exchanges 
    … …  
    13671452         !  
    13681453      ENDIF 
     1454   ! 
     1455      IF(.NOT. wrk_release(2, 1,2,3,4,5,6,7,8,9))THEN 
     1456         CALL ctl_stop('sbc_cpl_snd: failed to release workspace arrays.'); 
     1457         RETURN 
     1458      END IF 
    13691459   ! 
    13701460   END SUBROUTINE sbc_cpl_snd 

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

    r2528 r2590  
    2222   PRIVATE 
    2323   INTEGER, PUBLIC              ::   nday_qsr                    ! day when parameters were computed 
    24    REAL(wp), DIMENSION(jpi,jpj) ::   raa , rbb  , rcc  , rab     ! parameters used to compute the diurnal cycle 
    25    REAL(wp), DIMENSION(jpi,jpj) ::   rtmd, rdawn, rdusk, rscal   !     -       -         -           -      - 
     24   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   raa , rbb  , rcc  , rab     ! parameters used to compute the diurnal cycle 
     25   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rtmd, rdawn, rdusk, rscal   !     -       -         -           -      - 
    2626   
    27    PUBLIC   sbc_dcy     ! routine called by sbc 
     27   PUBLIC   sbc_dcy        ! routine called by sbc 
     28   PUBLIC   sbc_dcy_alloc  ! routine called by nemogcm.F90 
    2829 
    2930   !!---------------------------------------------------------------------- 
    … …  
    3334   !!---------------------------------------------------------------------- 
    3435CONTAINS 
     36 
     37      FUNCTION sbc_dcy_alloc() 
     38         !!---------------------------------------------------------------------- 
     39         !!                ***  ROUTINE sbc_dcy_alloc  *** 
     40         !!---------------------------------------------------------------------- 
     41         IMPLICIT none 
     42         INTEGER :: sbc_dcy_alloc 
     43         !!---------------------------------------------------------------------- 
     44 
     45         ALLOCATE(raa(jpi,jpj),  rbb(jpi,jpj),   rcc(jpi,jpj),   rab(jpi,jpj),   & 
     46                  rtmd(jpi,jpj), rdawn(jpi,jpj), rdusk(jpi,jpj), rscal(jpi,jpj), & 
     47                  Stat=sbc_dcy_alloc) 
     48 
     49         IF(sbc_dcy_alloc /= 0)THEN 
     50            CALL ctl_warn('sbc_dcy_alloc: failed to allocate arrays.') 
     51         END IF 
     52 
     53      END FUNCTION sbc_dcy_alloc 
     54 
    3555 
    3656      FUNCTION sbc_dcy( pqsrin ) RESULT( zqsrout ) 

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

    r2528 r2590  
    2828   PRIVATE 
    2929 
    30    PUBLIC   sbc_fwb      ! routine called by step 
     30   PUBLIC   sbc_fwb       ! routine called by step 
     31   PUBLIC   sbc_fwb_alloc ! routine called in nemogcm.F90 
    3132 
    3233   REAL(wp) ::   a_fwb_b            ! annual domain averaged freshwater budget 
    … …  
    3536   REAL(wp) ::   area               ! global mean ocean surface (interior domain) 
    3637 
    37    REAL(wp), DIMENSION(jpi,jpj) ::   e1e2    ! area of the interior domain (e1t*e2t) 
     38   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2    ! area of the interior domain (e1t*e2t) 
    3839 
    3940   !! * Substitutions 
    … …  
    4647   !!---------------------------------------------------------------------- 
    4748CONTAINS 
     49 
     50   FUNCTION sbc_fwb_alloc() 
     51      !!--------------------------------------------------------------------- 
     52      !!                ***  ROUTINE sbc_fwb_alloc  *** 
     53      !!--------------------------------------------------------------------- 
     54      IMPLICIT none 
     55      INTEGER :: sbc_fwb_alloc 
     56      !!--------------------------------------------------------------------- 
     57 
     58     ALLOCATE(e1e2(jpi,jpj), Stat=sbc_fwb_alloc) 
     59 
     60     IF(sbc_fwb_alloc /= 0)THEN 
     61        CALL ctl_warn('sbc_fwb_alloc: failed to allocate array.') 
     62     END IF 
     63 
     64   END FUNCTION sbc_fwb_alloc 
     65 
    4866 
    4967   SUBROUTINE sbc_fwb( kt, kn_fwb, kn_fsbc ) 
    … …  
    6078      !!                   & spread out over erp area depending its sign 
    6179      !!---------------------------------------------------------------------- 
     80      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     81      USE wrk_nemo, ONLY:      ztmsk_neg => wrk_2d_1, ztmsk_pos=> wrk_2d_2 
     82      USE wrk_nemo, ONLY: ztmsk_tospread => wrk_2d_3 
     83      USE wrk_nemo, ONLY:          z_wgt => wrk_2d_4, zerp_cor => wrk_2d_5 
     84      !! 
    6285      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    6386      INTEGER, INTENT( in ) ::   kn_fsbc  !  
    … …  
    6891      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp       ! temporary scalars 
    6992      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread 
    70       REAL(wp), DIMENSION(jpi,jpj) ::   ztmsk_neg, ztmsk_pos, ztmsk_tospread 
    71       REAL(wp), DIMENSION(jpi,jpj) ::   z_wgt, zerp_cor 
    7293      !!---------------------------------------------------------------------- 
     94      ! 
     95      IF( .NOT. wrk_use(2, 1,2,3,4,5))THEN 
     96         CALL ctl_stop('sbc_fwb: requested workspace arrays are unavailable.') 
     97         RETURN 
     98      END IF 
    7399      ! 
    74100      IF( kt == nit000 ) THEN 
    … …  
    192218      END SELECT 
    193219      ! 
     220      IF( .NOT. wrk_release(2, 1,2,3,4,5))THEN 
     221         CALL ctl_stop('sbc_fwb: failed to release workspace arrays.') 
     222      END IF 
     223      ! 
    194224   END SUBROUTINE sbc_fwb 
    195225 

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

    r2528 r2590  
    8888      !!                utau, vtau, taum, wndm, qns , qsr, emp , emps 
    8989      !!--------------------------------------------------------------------- 
     90      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     91      USE wrk_nemo, ONLY: alb_ice_os => wrk_3d_1 ! albedo of the ice under overcast sky 
     92      USE wrk_nemo, ONLY: alb_ice_os => wrk_3d_2 ! albedo of ice under clear sky 
     93      !! 
    9094      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    9195      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE) 
    … …  
    9397      INTEGER  ::   jl                 ! loop index 
    9498      REAL(wp) ::   zcoef              ! temporary scalar 
    95       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   alb_ice_os   ! albedo of the ice under overcast sky 
    96       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   alb_ice_cs   ! albedo of ice under clear sky 
    9799      !!---------------------------------------------------------------------- 
     100 
     101      IF(.NOT. wrk_use(3, 1,2))THEN 
     102         CALL ctl_stop('sbc_ice_lim: requested workspace arrays are unavailable.') 
     103         RETURN 
     104      ELSE IF(jpl > jpk)THEN 
     105         CALL ctl_stop('sbc_ice_lim: extent of 3rd dimension of workspace arrays needs to exceed jpk.') 
     106         RETURN 
     107      END IF 
    98108 
    99109      IF( kt == nit000 ) THEN 
    … …  
    244254       
    245255!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
     256      ! 
     257      IF(.NOT. wrk_release(3, 1,2))THEN 
     258         CALL ctl_stop('sbc_ice_lim: failed to release workspace arrays.') 
     259      END IF 
    246260      ! 
    247261   END SUBROUTINE sbc_ice_lim 

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

    r2528 r2590  
    8383      !!                utau, vtau, taum, wndm, qns , qsr, emp , emps 
    8484      !!--------------------------------------------------------------------- 
     85      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     86      USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2, wrk_3d_3 
     87      !! 
    8588      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    8689      INTEGER, INTENT(in) ::   ksbc    ! type of sbc ( =3 CLIO bulk ; =4 CORE bulk ; =5 coupled ) 
    8790      !! 
    8891      INTEGER  ::   ji, jj   ! dummy loop indices 
    89       REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb_ice_os   ! albedo of the ice under overcast sky 
    90       REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb_ice_cs   ! albedo of ice under clear sky 
    91       REAL(wp), DIMENSION(jpi,jpj,1) ::   zsist        ! surface ice temperature (K) 
     92      ! Pointers into workspaces contained in the wrk_nemo module 
     93      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_os   ! albedo of the ice under overcast sky 
     94      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_cs   ! albedo of ice under clear sky 
     95      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist         ! surface ice temperature (K) 
    9296      !!---------------------------------------------------------------------- 
     97 
     98      IF(.NOT. wrk_use(3, 1,2,3))THEN 
     99         CALL ctl_stop('sbc_ice_lim_2: requested workspace arrays are unavailable.') 
     100         RETURN 
     101      END IF 
     102      ! Use pointers to access only sub-arrays of workspaces 
     103      zalb_ice_os => wrk_3d_1(:,:,1:1) 
     104      zalb_ice_cs => wrk_3d_2(:,:,1:1) 
     105            zsist => wrk_3d_3(:,:,1:1) 
    93106 
    94107      IF( kt == nit000 ) THEN 
    … …  
    129142 
    130143         ! ... ice albedo (clear sky and overcast sky) 
    131          CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), reshape( hsnif, (/jpi,jpj,1/) ), zalb_ice_cs, zalb_ice_os ) 
     144         CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), & 
     145                                 reshape( hsnif, (/jpi,jpj,1/) ), & 
     146                          zalb_ice_cs, zalb_ice_os ) 
    132147 
    133148         ! ... Sea-ice surface boundary conditions output from bulk formulae : 
    … …  
    214229      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    215230      ! 
     231      IF(.NOT. wrk_release(3, 1,2,3))THEN 
     232         CALL ctl_stop('sbc_ice_lim_2: failed to release workspace arrays.') 
     233      END IF 
     234      ! 
    216235   END SUBROUTINE sbc_ice_lim_2 
    217236 
    … …  
    222241CONTAINS 
    223242   SUBROUTINE sbc_ice_lim_2 ( kt, ksbc )     ! Dummy routine 
     243      INTEGER, INTENT(in) ::   kt       
     244      INTEGER, INTENT(in) ::   ksbc     
    224245      WRITE(*,*) 'sbc_ice_lim_2: You should not have seen this print! error?', kt, ksbc 
    225246   END SUBROUTINE sbc_ice_lim_2 

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

    r2528 r2590  
    3030   PUBLIC   sbc_rnf       ! routine call in sbcmod module 
    3131   PUBLIC   sbc_rnf_div   ! routine called in sshwzv module 
     32   PUBLIC   sbc_rnf_alloc ! routine called in nemogcm module 
    3233 
    3334   !                                                      !!* namsbc_rnf namelist * 
    … …  
    4849 
    4950   INTEGER , PUBLIC                          ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths 
    50    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)      ::   rnfmsk            !: river mouth mask (hori.) 
    51    REAL(wp), PUBLIC, DIMENSION(jpk)          ::   rnfmsk_z          !: river mouth mask (vert.) 
    52    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)      ::   h_rnf             !: depth of runoff in m 
    53    INTEGER,  PUBLIC, DIMENSION(jpi,jpj)      ::   nk_rnf            !: depth of runoff in model levels 
    54    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) :: rnf_tsc_b, rnf_tsc  !: before and now T & S contents of runoffs  [K.m/s & PSU.m/s] 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rnfmsk            !: river mouth mask (hori.) 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   rnfmsk_z          !: river mouth mask (vert.) 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   h_rnf             !: depth of runoff in m 
     54   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nk_rnf            !: depth of runoff in model levels 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rnf_tsc_b, rnf_tsc  !: before and now T & S contents of runoffs  [K.m/s & PSU.m/s] 
    5556    
    5657   REAL(wp) ::   r1_rau0   ! = 1 / rau0  
    … …  
    6869   !!---------------------------------------------------------------------- 
    6970CONTAINS 
     71 
     72   FUNCTION sbc_rnf_alloc() 
     73      !!---------------------------------------------------------------------- 
     74      !!                ***  ROUTINE sbc_rnf_alloc  *** 
     75      !!---------------------------------------------------------------------- 
     76      IMPLICIT none 
     77      INTEGER :: sbc_rnf_alloc 
     78      !!---------------------------------------------------------------------- 
     79 
     80      ALLOCATE(rnfmsk(jpi,jpj),         rnfmsk_z(jpk),         & 
     81               h_rnf(jpi,jpj),          nk_rnf(jpi,jpj),       & 
     82               rnf_tsc_b(jpi,jpj,jpts), rnf_tsc(jpi,jpj,jpts), & 
     83               Stat=sbc_rnf_alloc) 
     84 
     85      IF(sbc_rnf_alloc > 0)THEN 
     86         CALL ctl_warn('sbc_rnf_alloc: allocation of arrays failed.') 
     87      END IF 
     88 
     89   END FUNCTION sbc_rnf_alloc 
    7090 
    7191   SUBROUTINE sbc_rnf( kt ) 
    … …  
    182202      !! ** Action  :   phdivn   decreased by the runoff inflow 
    183203      !!---------------------------------------------------------------------- 
    184       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phdivn   ! horizontal divergence 
     204      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence 
    185205      !! 
    186206      INTEGER  ::   ji, jj, jk   ! dummy loop indices 

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

    r2528 r2590  
    2525   PRIVATE 
    2626 
    27    PUBLIC   sbc_ssr    ! routine called in sbcmod 
    28     
    29  
    30    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   erp      !: evaporation damping   [kg/m2/s] 
    31    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qrp      !: heat flux damping        [w/m2] 
     27   PUBLIC   sbc_ssr       ! routine called in sbcmod 
     28   PUBLIC   sbc_ssr_alloc ! routine called in nemgcm 
     29 
     30   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   erp      !: evaporation damping   [kg/m2/s] 
     31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qrp      !: heat flux damping        [w/m2] 
    3232 
    3333   !                                           !!* Namelist namsbc_ssr * 
    … …  
    5252 
    5353CONTAINS 
     54 
     55   FUNCTION sbc_ssr_alloc() 
     56      !!--------------------------------------------------------------------- 
     57      !!                  ***  ROUTINE sbc_ssr_alloc  *** 
     58      !!--------------------------------------------------------------------- 
     59      IMPLICIT none 
     60      INTEGER :: sbc_ssr_alloc 
     61      !!--------------------------------------------------------------------- 
     62 
     63      ALLOCATE(erp(jpi,jpj), qrp(jpi,jpj), Stat=sbc_ssr_alloc) 
     64 
     65      IF(sbc_ssr_alloc > 0)THEN 
     66         CALL ctl_warn('sbc_ssr_alloc: allocation of arrays failed.') 
     67      END IF 
     68 
     69   END FUNCTION sbc_ssr_alloc 
    5470 
    5571   SUBROUTINE sbc_ssr( kt ) 
Note: See TracChangeset for help on using the changeset viewer.