Changeset 2690 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

Timestamp:

2011-03-15T16:27:46+01:00 (13 years ago)

Author:

gm

Message:

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

File:

• branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90 (modified) (10 diffs)

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

@@ -54 +54 @@
    INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s)
    INTEGER , PARAMETER ::   jp_tdif = 9           ! index of tau diff associated to HF tau   (N/m2)   at T-point
+   
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read)
          
@@ -111 +112 @@
       !!              - emp, emps   evaporation minus precipitation
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
       !!
       INTEGER  ::   ierror   ! return error code
@@ -231 +232 @@
 
       IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13) ) THEN
-         CALL ctl_stop('blk_oce_core: requested workspace arrays unavailable.')   ;   RETURN
+         CALL ctl_stop('blk_oce_core: requested workspace arrays unavailable')   ;   RETURN
       ENDIF
       !
@@ -605 +606 @@
       ENDIF
 
-      IF( wrk_not_released(2, 1) .OR.   &
+      IF( wrk_not_released(2, 1)       .OR.   &
           wrk_not_released(3, 4,5,6,7) )   CALL ctl_stop('blk_ice_core: failed to release workspace arrays')
       !
@@ -663 +664 @@
       !!----------------------------------------------------------------------
 
-      IF( wrk_in_use(2,             14,15,16,17,18,19,      &
-                        20,21,22,23,24,25,26,27,28,29,      &
-                        30,31,32)                      .OR. &
-          iwrk_in_use(2, 1)                              ) THEN
+      IF(  wrk_in_use(2,             14,15,16,17,18,19,        &
+                         20,21,22,23,24,25,26,27,28,29,        &
+                         30,31,32)                      .OR.   &
+          iwrk_in_use(2, 1)                               ) THEN
          CALL ctl_stop('TURB_CORE_1Z: requested workspace arrays unavailable')   ;   RETURN
       ENDIF
@@ -797 +798 @@
       !!  * Start
 
-      IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21) .OR. &
-          iwrk_in_use(2, 1) )THEN
-         CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable.')
-         RETURN
+      IF(  wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21) .OR. &
+          iwrk_in_use(2, 1) ) THEN
+         CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable')   ;   RETURN
       END IF
 
@@ -876 +876 @@
       END DO
       !!
-      IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21) .OR. &
-          iwrk_not_released(2, 1) )THEN
-         CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable.')
-      END IF
+      IF(  wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21) .OR.   &
+          iwrk_not_released(2, 1)    )   CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable')
       !
     END SUBROUTINE TURB_CORE_2Z
@@ -897 +895 @@
       !-------------------------------------------------------------------------------
 
-      IF(wrk_in_use(2, 33,34,35))THEN
-         CALL ctl_stop('psi_m: requested workspace arrays unavailable.')
-         RETURN
-      END IF
+      IF( wrk_in_use(2, 33,34,35) ) THEN
+         CALL ctl_stop('psi_m: requested workspace arrays unavailable')   ;   RETURN
+      ENDIF
 
       X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.0) ;  X  = sqrt(X2)
       stabit    = 0.5 + sign(0.5,zta)
-      psi_m = -5.*zta*stabit  &                                                  ! Stable
-           & + (1. - stabit)*(2*log((1. + X)/2) + log((1. + X2)/2) - 2*atan(X) + pi/2)  ! Unstable 
-
-      IF( wrk_not_released(2, 33,34,35) ) THEN
-         CALL ctl_stop('psi_m: failed to release workspace arrays.')
-         RETURN
-      END IF
-
+      psi_m = -5.*zta*stabit  &                                                          ! Stable
+         &    + (1. - stabit)*(2*log((1. + X)/2) + log((1. + X2)/2) - 2*atan(X) + pi/2)  ! Unstable 
+
+      IF( wrk_not_released(2, 33,34,35) )   CALL ctl_stop('psi_m: failed to release workspace arrays')
+      !
     END FUNCTION psi_m
 
 
-    FUNCTION psi_h(zta)    !! Psis, L & Y eq. (8c), (8d), (8e)
+    FUNCTION psi_h( zta )    !! Psis, L & Y eq. (8c), (8d), (8e)
       !-------------------------------------------------------------------------------
       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
@@ -921 +915 @@
       USE wrk_nemo, ONLY:     X  => wrk_2d_34
       USE wrk_nemo, ONLY: stabit => wrk_2d_35
-      !!
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: zta
-
-      REAL(wp), DIMENSION(jpi,jpj)             :: psi_h
+      !
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   zta
+      !
+      REAL(wp), DIMENSION(jpi,jpj)             ::   psi_h
       !-------------------------------------------------------------------------------
 
@@ -934 +928 @@
       stabit    = 0.5 + sign(0.5,zta)
       psi_h = -5.*zta*stabit  &                                       ! Stable
-           & + (1. - stabit)*(2.*log( (1. + X2)/2. ))                 ! Unstable
-
-      IF( wrk_not_released(2, 33,34,35) )   CALL ctl_stop('psi_h: failed to release workspace arrays.')
+         &    + (1. - stabit)*(2.*log( (1. + X2)/2. ))                 ! Unstable
+
+      IF( wrk_not_released(2, 33,34,35) )   CALL ctl_stop('psi_h: failed to release workspace arrays')
       !
     END FUNCTION psi_h