Changeset 2616
- Timestamp:
- 2011-02-26T11:28:03+01:00 (13 years ago)
- Location:
- branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 13 edited
-
ZDF/zdf_oce.F90 (modified) (2 diffs)
-
ZDF/zdfbfr.F90 (modified) (2 diffs)
-
ZDF/zdfddm.F90 (modified) (4 diffs)
-
ZDF/zdfddm_substitute.h90 (modified) (2 diffs)
-
ZDF/zdfevd.F90 (modified) (2 diffs)
-
ZDF/zdfgls.F90 (modified) (19 diffs)
-
ZDF/zdfini.F90 (modified) (1 diff)
-
ZDF/zdfkpp.F90 (modified) (7 diffs)
-
ZDF/zdfmxl.F90 (modified) (6 diffs)
-
ZDF/zdfric.F90 (modified) (4 diffs)
-
ZDF/zdftke.F90 (modified) (7 diffs)
-
ZDF/zdftmx.F90 (modified) (6 diffs)
-
nemogcm.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
r2590 r2616 7 7 !! 3.2 ! 2009-07 (G.Madec) addition of avm 8 8 !!---------------------------------------------------------------------- 9 USE par_oce ! ocean parameters 9 USE par_oce ! ocean parameters 10 USE in_out_manager ! I/O manager 10 11 11 12 IMPLICIT NONE 12 13 PRIVATE 13 14 14 ! Routine accessibility15 15 PUBLIC zdf_oce_alloc ! Called in nemogcm.F90 16 16 … … 39 39 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION( :,:) :: avtb_2d !: set in tke_init, for other modif than ice 40 40 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION( :,:) :: bfrua, bfrva !: Bottom friction coefficients set in zdfbfr 41 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avmu , avmv !: vertical viscosity coef at uw- & vw-pts 42 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avm , avt !: vertical viscosity & diffusivity coef at w-pt 41 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avmu , avmv !: vertical viscosity coef at uw- & vw-pts [m2/s] 42 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avm , avt !: vertical viscosity & diffusivity coef at w-pt [m2/s] 43 43 44 44 !!---------------------------------------------------------------------- 45 !! NEMO/OPA 3.3 , NEMO Consortium (2010)45 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 46 46 !! $Id$ 47 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)48 !! ======================================================================47 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 48 !!---------------------------------------------------------------------- 49 49 CONTAINS 50 50 51 FUNCTION zdf_oce_alloc()51 INTEGER FUNCTION zdf_oce_alloc() 52 52 !!---------------------------------------------------------------------- 53 !! *** Routinezdf_oce_alloc ***53 !! *** FUNCTION zdf_oce_alloc *** 54 54 !!---------------------------------------------------------------------- 55 USE in_out_manager, ONLY: ctl_warn 56 IMPLICIT none 57 INTEGER zdf_oce_alloc 58 !!---------------------------------------------------------------------- 59 60 ALLOCATE(avmb(jpk), avtb(jpk), avtb_2d(jpi,jpj), & 61 bfrua(jpi,jpj), bfrva(jpi,jpj), & 62 avmu(jpi,jpj,jpk), avmv(jpi,jpj,jpk), & 63 avm(jpi,jpj,jpk), avt(jpi,jpj,jpk), & 64 Stat = zdf_oce_alloc ) 65 66 IF(zdf_oce_alloc /= 0)THEN 67 CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays.') 68 END IF 69 55 ! 56 ALLOCATE(avmb(jpk) , bfrua(jpi,jpj) , & 57 & avtb(jpk) , bfrva(jpi,jpj) , avtb_2d(jpi,jpj) , & 58 & avmu(jpi,jpj,jpk), avm(jpi,jpj,jpk) , & 59 & avmv(jpi,jpj,jpk), avt(jpi,jpj,jpk) , STAT = zdf_oce_alloc ) 60 ! 61 IF( zdf_oce_alloc /= 0 ) CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays') 62 ! 70 63 END FUNCTION zdf_oce_alloc 71 64 65 !!====================================================================== 72 66 END MODULE zdf_oce -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r2590 r2616 40 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: bfrcoef2d ! 2D bottom drag coefficient 41 41 ! Now initialised in zdf_bfr_alloc() 42 43 42 !! * Substitutions 44 43 # include "vectopt_loop_substitute.h90" 45 44 # include "domzgr_substitute.h90" 46 45 !!---------------------------------------------------------------------- 47 !! NEMO/OPA 3.3 , NEMO Consortium (2010)46 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 48 47 !! $Id$ 49 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 51 50 CONTAINS 52 51 53 FUNCTION zdf_bfr_alloc() 54 !!---------------------------------------------------------------------- 55 !! *** ROUTINE zdf_bfr_alloc *** 56 !!---------------------------------------------------------------------- 57 IMPLICIT none 58 INTEGER :: zdf_bfr_alloc 59 !!---------------------------------------------------------------------- 60 61 ALLOCATE(bfrcoef2d(jpi,jpj), Stat=zdf_bfr_alloc) 62 63 IF(zdf_bfr_alloc == 0)THEN 64 bfrcoef2d(:,:) = 1.e-3_wp 65 ELSE 66 CALL ctl_warn('zdf_bfr_alloc: allocation of array bfrcoef2d failed.') 67 END IF 68 52 INTEGER FUNCTION zdf_bfr_alloc() 53 !!---------------------------------------------------------------------- 54 !! *** FUNCTION zdf_bfr_alloc *** 55 !!---------------------------------------------------------------------- 56 ALLOCATE( bfrcoef2d(jpi,jpj), STAT=zdf_bfr_alloc ) 57 ! 58 IF( lk_mpp ) CALL mpp_sum ( zdf_bfr_alloc ) 59 IF( zdf_bfr_alloc /= 0 ) CALL ctl_warn('zdf_bfr_alloc: failed to allocate arrays.') 69 60 END FUNCTION zdf_bfr_alloc 70 61 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
r2590 r2616 41 41 # include "vectopt_loop_substitute.h90" 42 42 !!---------------------------------------------------------------------- 43 !! NEMO/OPA 3.3 , NEMO Consortium (2010)43 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 44 44 !! $Id$ 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 !!---------------------------------------------------------------------- 47 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 !!---------------------------------------------------------------------- 48 47 CONTAINS 49 48 50 FUNCTION zdf_ddm_alloc()49 INTEGER FUNCTION zdf_ddm_alloc() 51 50 !!---------------------------------------------------------------------- 52 51 !! *** ROUTINE zdf_ddm_alloc *** 53 52 !!---------------------------------------------------------------------- 54 IMPLICIT none 55 INTEGER zdf_ddm_alloc 56 !!---------------------------------------------------------------------- 57 58 ALLOCATE( avs(jpi,jpj,jpk), rrau(jpi,jpj,jpk), Stat = zdf_ddm_alloc) 59 60 IF(zdf_ddm_alloc /= 0)THEN 61 CALL ctl_warn('zdf_ddm_alloc: failed to allocate avs and rrau arrays.') 62 END IF 63 53 ALLOCATE( avs(jpi,jpj,jpk), rrau(jpi,jpj,jpk), STAT = zdf_ddm_alloc ) 54 ! 55 IF( lk_mpp ) CALL mpp_sum ( zdf_ddm_alloc ) 56 IF( zdf_ddm_alloc /= 0 ) CALL ctl_warn('zdf_ddm_alloc: failed to allocate arrays') 64 57 END FUNCTION zdf_ddm_alloc 65 58 … … 111 104 !!---------------------------------------------------------------------- 112 105 113 IF(.not. wrk_use(2, 1,2,3,4,5))THEN 114 CALL ctl_stop('zdf_ddm: Requested workspace arrays already in use.') 115 RETURN 106 IF( .NOT. wrk_use(2, 1,2,3,4,5) ) THEN 107 CALL ctl_stop('zdf_ddm: Requested workspace arrays already in use.') ; RETURN 116 108 END IF 117 109 … … 206 198 ENDIF 207 199 ! 208 IF(.not. wrk_release(2, 1,2,3,4,5))THEN 209 CALL ctl_stop('zdf_ddm: Release of workspace arrays failed.') 210 END IF 200 IF( .NOT. wrk_release(2, 1,2,3,4,5) ) CALL ctl_stop('zdf_ddm: Release of workspace arrays failed') 211 201 ! 212 202 END SUBROUTINE zdf_ddm … … 238 228 ENDIF 239 229 ! 230 ! ! allocate zdfddm arrays 231 IF( zdf_ddm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' ) 232 ! 240 233 END SUBROUTINE zdf_ddm_init 241 234 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm_substitute.h90
r2528 r2616 4 4 !! ** purpose : substitute fsaht. the eddy diffusivity coeff. 5 5 !! with a constant or 1D or 2D or 3D array, using CPP macro. 6 !!----------------------------------------------------------------------7 !!----------------------------------------------------------------------8 !! NEMO/OPA 3.3 , NEMO Consortium (2010)9 !! $Id$10 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)11 6 !!---------------------------------------------------------------------- 12 7 #if defined key_zdfddm … … 17 12 # define fsavs(i,j,k) avt(i,j,k) 18 13 #endif 14 !!---------------------------------------------------------------------- 15 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 16 !! $Id$ 17 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 18 !!---------------------------------------------------------------------- -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
r2528 r2616 31 31 # include "domzgr_substitute.h90" 32 32 !!---------------------------------------------------------------------- 33 !! NEMO/OPA 3.3 , NEMO Consortium (2010)33 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 34 34 !! $Id$ 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- 37 38 37 CONTAINS 39 38 … … 53 52 !! References : Lazar, A., these de l'universite Paris VI, France, 1997 54 53 !!---------------------------------------------------------------------- 55 USE oce, zavt_evd => ua 56 USE oce, zavm_evd => va 54 USE oce, zavt_evd => ua ! use ua as workspace 55 USE oce, zavm_evd => va ! use va as workspace 57 56 !! 58 INTEGER, INTENT( in ) :: kt 57 INTEGER, INTENT( in ) :: kt ! ocean time-step indexocean time step 59 58 !! 60 INTEGER :: ji, jj, jk 59 INTEGER :: ji, jj, jk ! dummy loop indices 61 60 !!---------------------------------------------------------------------- 62 61 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r2590 r2616 35 35 PUBLIC zdf_gls_init ! routine called in opa module 36 36 PUBLIC gls_rst ! routine called in step module 37 PUBLIC zdf_gls_alloc ! routine called in nemogcm module 38 39 LOGICAL , PUBLIC, PARAMETER :: lk_zdfgls = .TRUE. !: TKE vertical mixing flag37 38 LOGICAL , PUBLIC, PARAMETER :: lk_zdfgls = .TRUE. !: TKE vertical mixing flag 39 ! 40 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy 41 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mxln !: now mixing length … … 111 111 CONTAINS 112 112 113 FUNCTION zdf_gls_alloc()113 INTEGER FUNCTION zdf_gls_alloc() 114 114 !!---------------------------------------------------------------------- 115 !! *** ROUTINEzdf_gls_alloc ***115 !! *** FUNCTION zdf_gls_alloc *** 116 116 !!---------------------------------------------------------------------- 117 IMPLICIT none 118 INTEGER :: zdf_gls_alloc 119 !!---------------------------------------------------------------------- 120 121 ALLOCATE(en(jpi,jpj,jpk), mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk), & 122 ustars2(jpi,jpj), ustarb2(jpi,jpj), & 123 Stat=zdf_gls_alloc) 124 125 IF(zdf_gls_alloc /= 0)THEN 126 CALL ctl_warn('zdf_gls_alloc: failed to allocate arrays.') 127 END IF 128 117 ALLOCATE( en(jpi,jpj,jpk), mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) , & 118 & ustars2(jpi,jpj), ustarb2(jpi,jpj) , STAT=zdf_gls_alloc ) 119 ! 120 IF( lk_mpp ) CALL mpp_sum ( zdf_gls_alloc ) 121 IF( zdf_gls_alloc /= 0 ) CALL ctl_warn('zdf_gls_alloc: failed to allocate arrays') 129 122 END FUNCTION zdf_gls_alloc 130 123 … … 160 153 !!-------------------------------------------------------------------- 161 154 162 IF( (.NOT. wrk_use(2, 1,2,3)) .OR. (.NOT. wrk_use(3, 1,2,3,4,5)) )THEN 163 CALL ctl_stop('zdf_gls: requested workspace arrays unavailable.') 164 RETURN 155 IF( .NOT. wrk_use(2, 1,2,3) .OR. .NOT. wrk_use(3, 1,2,3,4,5) ) THEN 156 CALL ctl_stop('zdf_gls: requested workspace arrays unavailable.') ; RETURN 165 157 END IF 166 158 … … 890 882 ENDIF 891 883 ! 892 IF( (.NOT. wrk_release(2, 1,2,3)) .OR. & 893 (.NOT. wrk_release(3, 1,2,3,4,5)) )THEN 894 CALL ctl_stop('zdf_gls: failed to release workspace arrays.') 895 END IF 884 IF( .NOT. wrk_release(2, 1,2,3) .OR. & 885 .NOT. wrk_release(3, 1,2,3,4,5) ) CALL ctl_stop('zdf_gls: failed to release workspace arrays') 896 886 ! 897 887 END SUBROUTINE zdf_gls … … 927 917 !!---------------------------------------------------------- 928 918 929 REWIND ( numnam )!* Read Namelist namzdf_gls930 READ 919 REWIND( numnam ) !* Read Namelist namzdf_gls 920 READ ( numnam, namzdf_gls ) 931 921 932 922 IF(lwp) THEN !* Control print … … 954 944 ENDIF 955 945 946 ! !* allocate gls arrays 947 IF( zdf_gls_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_gls_init : unable to allocate arrays' ) 948 956 949 ! !* Check of some namelist values 957 950 IF( nn_tkebc_surf < 0 .OR. nn_tkebc_surf > 1 ) CALL ctl_stop( 'bad flag: nn_tkebc_surf is 0 or 1' ) … … 962 955 IF( nn_clos < 0 .OR. nn_clos > 3 ) CALL ctl_stop( 'bad flag: nn_clos is 0, 1, 2 or 3' ) 963 956 964 ! Initialisation of the parameters for the choosen closure 965 ! -------------------------------------------------------- 966 ! 967 SELECT CASE ( nn_clos ) 968 ! 969 CASE( 0 ) ! k-kl (Mellor-Yamada) 957 SELECT CASE ( nn_clos ) !* set the parameters for the chosen closure 958 ! 959 CASE( 0 ) ! k-kl (Mellor-Yamada) 970 960 ! 971 961 IF(lwp) WRITE(numout,*) 'The choosen closure is k-kl closed to the classical Mellor-Yamada' … … 985 975 END SELECT 986 976 ! 987 CASE( 1 ) ! k-eps977 CASE( 1 ) ! k-eps 988 978 ! 989 979 IF(lwp) WRITE(numout,*) 'The choosen closure is k-eps' … … 1003 993 END SELECT 1004 994 ! 1005 CASE( 2 ) ! k-omega995 CASE( 2 ) ! k-omega 1006 996 ! 1007 997 IF(lwp) WRITE(numout,*) 'The choosen closure is k-omega' … … 1021 1011 END SELECT 1022 1012 ! 1023 CASE( 3 ) ! generic1013 CASE( 3 ) ! generic 1024 1014 ! 1025 1015 IF(lwp) WRITE(numout,*) 'The choosen closure is generic' … … 1041 1031 END SELECT 1042 1032 1043 ! Initialisation of the parameters of the stability functions 1044 ! ----------------------------------------------------------- 1045 ! 1046 SELECT CASE ( nn_stab_func ) 1047 ! 1048 CASE ( 0 ) ! Galperin stability functions 1033 ! 1034 SELECT CASE ( nn_stab_func ) !* set the parameters of the stability functions 1035 ! 1036 CASE ( 0 ) ! Galperin stability functions 1049 1037 ! 1050 1038 IF(lwp) WRITE(numout,*) 'Stability functions from Galperin' … … 1058 1046 rghcri = 0.02_wp 1059 1047 ! 1060 CASE ( 1 ) ! Kantha-Clayson stability functions1048 CASE ( 1 ) ! Kantha-Clayson stability functions 1061 1049 ! 1062 1050 IF(lwp) WRITE(numout,*) 'Stability functions from Kantha-Clayson' … … 1070 1058 rghcri = 0.02_wp 1071 1059 ! 1072 CASE ( 2 ) ! Canuto A stability functions1060 CASE ( 2 ) ! Canuto A stability functions 1073 1061 ! 1074 1062 IF(lwp) WRITE(numout,*) 'Stability functions from Canuto A' … … 1094 1082 rghcri = 0.03_wp 1095 1083 ! 1096 CASE ( 3 ) ! Canuto B stability functions1084 CASE ( 3 ) ! Canuto B stability functions 1097 1085 ! 1098 1086 IF(lwp) WRITE(numout,*) 'Stability functions from Canuto B' … … 1119 1107 END SELECT 1120 1108 1121 ! Set Schmidt number for psi diffusion in the wave breaking case1122 ! See equation 13 of Carniel et al, Ocean modelling, 30, 225-239, 20091123 ! or equation(17) of Burchard, JPO, 31, 3133-3145, 20011109 ! !* Set Schmidt number for psi diffusion in the wave breaking case 1110 ! ! See Eq. (13) of Carniel et al, OM, 30, 225-239, 2009 1111 ! ! or Eq. (17) of Burchard, JPO, 31, 3133-3145, 2001 1124 1112 IF( ln_sigpsi .AND. ln_crban ) THEN 1125 1113 zcr = SQRT( 1.5_wp*rsc_tke ) * rcm_sf / vkarmn … … 1131 1119 ENDIF 1132 1120 1133 ! Shear free turbulence parameters:1121 ! !* Shear free turbulence parameters 1134 1122 ! 1135 1123 ra_sf = -4._wp * rnn * SQRT( rsc_tke ) / ( (1._wp+4._wp*rmm) * SQRT( rsc_tke ) & … … 1142 1130 1143 1131 ! 1144 IF(lwp) THEN !Control print1132 IF(lwp) THEN !* Control print 1145 1133 WRITE(numout,*) 1146 1134 WRITE(numout,*) 'Limit values' … … 1165 1153 ENDIF 1166 1154 1167 ! Constants initialization1155 ! !* Constants initialization 1168 1156 rc02 = rc0 * rc0 ; rc02r = 1. / rc02 1169 1157 rc03 = rc02 * rc0 … … 1192 1180 avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk) 1193 1181 END DO 1194 ! !* read or initialize all required files1195 CALL gls_rst( nit000, 'READ' ) 1182 ! 1183 CALL gls_rst( nit000, 'READ' ) !* read or initialize all required files 1196 1184 ! 1197 1185 END SUBROUTINE zdf_gls_init -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
r2528 r2616 37 37 38 38 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 3.3 , NEMO Consortium (2010)39 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 40 40 !! $Id$ 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 42 !!---------------------------------------------------------------------- 43 44 43 CONTAINS 45 44 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
r2613 r2616 9 9 !! 8.2 ! 2003-10 (Chanut J.) re-writting 10 10 !! NEMO 1.0 ! 2005-01 (C. Ethe, G. Madec) Free form, F90 + creation of tra_kpp routine 11 !! 3.3 ! 2010-10 11 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 12 12 !!---------------------------------------------------------------------- 13 13 #if defined key_zdfkpp || defined key_esopa … … 39 39 PUBLIC zdf_kpp_init ! routine called by opa.F90 40 40 PUBLIC tra_kpp ! routine called by step.F90 41 #if defined key_top42 41 PUBLIC trc_kpp ! routine called by trcstp.F90 43 #endif44 PUBLIC zdf_kpp_alloc ! routine called by nemogcm.F9045 42 46 43 LOGICAL , PUBLIC, PARAMETER :: lk_zdfkpp = .TRUE. !: KPP vertical mixing flag … … 147 144 # include "zdfddm_substitute.h90" 148 145 !!---------------------------------------------------------------------- 149 !! NEMO/OPA 3.3 , NEMO Consortium (2010)146 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 150 147 !! $Id$ 151 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)148 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 152 149 !!---------------------------------------------------------------------- 153 154 150 CONTAINS 155 151 156 FUNCTION zdf_kpp_alloc()157 IMPLICIT none158 INTEGER :: zdf_kpp_alloc159 160 ALLOCATE( ghats(jpi,jpj,jpk), wt0(jpi,jpj), ws0(jpi,jpj), hkpp(jpi,jpj), &152 INTEGER FUNCTION zdf_kpp_alloc() 153 !!---------------------------------------------------------------------- 154 !! *** FUNCTION zdf_kpp_alloc *** 155 !!---------------------------------------------------------------------- 156 ALLOCATE( ghats(jpi,jpj,jpk), wt0(jpi,jpj), ws0(jpi,jpj), hkpp(jpi,jpj), & 161 157 #if ! defined key_kpplktb 162 del(jpk,jpk), &163 #endif 164 ratt(jpk), &165 etmean(jpi,jpj,jpk), eumean(jpi,jpj,jpk), evmean(jpi,jpj,jpk), &158 & del(jpk,jpk), & 159 #endif 160 & ratt(jpk), & 161 & etmean(jpi,jpj,jpk), eumean(jpi,jpj,jpk), evmean(jpi,jpj,jpk), & 166 162 #if defined key_c1d 167 rig(jpi,jpj,jpk), rib(jpi,jpj,jpk), buof(jpi,jpj,jpk), & 168 mols(jpi,jpj,jpk), ekdp(jpi,jpj), & 169 #endif 170 Stat=zdf_kpp_alloc) 171 172 IF(zdf_kpp_alloc /= 0)THEN 173 CALL ctl_warn('zdf_kpp_alloc: failed to allocate arrays.') 174 END IF 175 163 & rig (jpi,jpj,jpk), rib(jpi,jpj,jpk), buof(jpi,jpj,jpk), & 164 & mols(jpi,jpj,jpk), ekdp(jpi,jpj), & 165 #endif 166 & STAT=zdf_kpp_alloc ) 167 ! 168 IF( lk_mpp ) CALL mpp_sum ( zdf_kpp_alloc ) 169 IF( zdf_kpp_alloc /= 0 ) CALL ctl_warn('zdf_kpp_alloc: failed to allocate arrays.') 176 170 END FUNCTION zdf_kpp_alloc 177 171 … … 280 274 !!-------------------------------------------------------------------- 281 275 282 IF( (.NOT. wrk_use(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14)) .OR. & 283 (.NOT. wrk_use(2, 1,2,3,4,5,6,7,8,9,10,11)) .OR. & 284 (.NOT. wrk_use_xz(1,2,3)) )THEN 285 CALL ctl_stop('zdf_kpp : requested workspace arrays unavailable.') 286 RETURN 276 IF( .NOT. wrk_use(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR. & 277 .NOT. wrk_use(2, 1,2,3,4,5,6,7,8,9,10,11) .OR. & 278 .NOT. wrk_use_xz(1,2,3) ) THEN 279 CALL ctl_stop('zdf_kpp : requested workspace arrays unavailable.') ; RETURN 287 280 END IF 288 281 ! Set-up pointers to 2D spaces … … 1241 1234 ENDIF 1242 1235 1243 IF( (.NOT. wrk_release(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14)) .OR. & 1244 (.NOT. wrk_release(2, 1,2,3,4,5,6,7,8,9,10,11)) .OR. & 1245 (.NOT. wrk_release_xz(1,2,3)) )THEN 1246 CALL ctl_stop('zdf_kpp : failed to release workspace arrays.') 1247 RETURN 1248 END IF 1249 1236 IF( .NOT. wrk_release(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR. & 1237 .NOT. wrk_release(2, 1,2,3,4,5,6,7,8,9,10,11) .OR. & 1238 .NOT. wrk_release_xz(1,2,3) ) CALL ctl_stop('zdf_kpp : failed to release workspace arrays.') 1239 ! 1250 1240 END SUBROUTINE zdf_kpp 1251 1241 … … 1416 1406 WRITE(numout,*) ' horizontal average flag nn_ave = ', nn_ave 1417 1407 ENDIF 1408 1409 ! ! allocate zdfkpp arrays 1410 IF( zdf_kpp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_kpp_init : unable to allocate arrays' ) 1418 1411 1419 1412 ll_kppcustom = .FALSE. … … 1610 1603 WRITE(*,*) 'tra_kpp: You should not have seen this print! error?', kt 1611 1604 END SUBROUTINE tra_kpp 1612 #if defined key_top1613 1605 SUBROUTINE trc_kpp( kt ) ! Dummy routine 1614 1606 WRITE(*,*) 'trc_kpp: You should not have seen this print! error?', kt 1615 1607 END SUBROUTINE trc_kpp 1616 1608 #endif 1617 #endif1618 1609 1619 1610 !!====================================================================== -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
r2590 r2616 20 20 21 21 PUBLIC zdf_mxl ! called by step.F90 22 PUBLIC zdf_mxl_alloc ! called by nemogcm.F9023 22 24 23 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nmln !: number of level in the mixed layer (used by TOP) … … 30 29 # include "domzgr_substitute.h90" 31 30 !!---------------------------------------------------------------------- 32 !! NEMO/OPA 3.3 , NEMO Consortium (2010)31 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 33 32 !! $Id$ 34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 35 34 !!---------------------------------------------------------------------- 36 37 35 CONTAINS 38 36 39 FUNCTION zdf_mxl_alloc()37 INTEGER FUNCTION zdf_mxl_alloc() 40 38 !!---------------------------------------------------------------------- 41 !! *** ROUTINEzdf_mxl_alloc ***39 !! *** FUNCTION zdf_mxl_alloc *** 42 40 !!---------------------------------------------------------------------- 43 IMPLICIT none 44 INTEGER :: zdf_mxl_alloc 45 !!---------------------------------------------------------------------- 46 47 ALLOCATE(nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), & 48 Stat=zdf_mxl_alloc) 49 50 IF(zdf_mxl_alloc /= 0)THEN 51 CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.') 52 END IF 53 41 ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT=zdf_mxl_alloc) 42 ! 43 IF( lk_mpp ) CALL mpp_sum ( zdf_mxl_alloc ) 44 IF( zdf_mxl_alloc /= 0 ) CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.') 54 45 END FUNCTION zdf_mxl_alloc 55 46 … … 73 64 !!---------------------------------------------------------------------- 74 65 USE wrk_nemo, ONLY: iwrk_use, iwrk_release 75 USE wrk_nemo, ONLY: imld => iwrk_2d_1 ! temporaryworkspace66 USE wrk_nemo, ONLY: imld => iwrk_2d_1 ! 2D workspace 76 67 !! 77 68 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 83 74 !!---------------------------------------------------------------------- 84 75 85 IF(.NOT. iwrk_use(2,1))THEN 86 CALL ctl_stop('zdf_mxl : requested workspace array unavailable.') 87 RETURN 76 IF( .NOT. iwrk_use(2,1) )THEN 77 CALL ctl_stop('zdf_mxl : requested workspace array unavailable.') ; RETURN 88 78 END IF 89 79 … … 92 82 IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth' 93 83 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 84 ! ! allocate zdfmxl arrays 85 IF( zdf_mxl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_mxl : unable to allocate arrays' ) 94 86 ENDIF 95 87 … … 120 112 IF(ln_ctl) CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 ) 121 113 ! 122 IF(.NOT. iwrk_release(2,1))THEN 123 CALL ctl_stop('zdf_mxl : failed to release workspace array.') 124 END IF 114 IF( .NOT. iwrk_release(2,1) ) CALL ctl_stop('zdf_mxl : failed to release workspace array') 125 115 ! 126 116 END SUBROUTINE zdf_mxl -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r2613 r2616 31 31 PUBLIC zdf_ric ! called by step.F90 32 32 PUBLIC zdf_ric_init ! called by opa.F90 33 PUBLIC zdf_ric_alloc ! called by nemogcm.F9034 33 35 34 LOGICAL, PUBLIC, PARAMETER :: lk_zdfric = .TRUE. !: Richardson vertical mixing flag … … 45 44 # include "domzgr_substitute.h90" 46 45 !!---------------------------------------------------------------------- 47 !! NEMO/OPA 3.3 , NEMO Consortium (2010)46 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 48 47 !! $Id$ 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 49 !!---------------------------------------------------------------------- 51 50 CONTAINS 52 51 53 FUNCTION zdf_ric_alloc() 54 !!---------------------------------------------------------------------- 55 !! *** ROUTINE zdfric *** 56 !!---------------------------------------------------------------------- 57 IMPLICIT none 58 INTEGER :: zdf_ric_alloc 59 !!---------------------------------------------------------------------- 60 61 ALLOCATE(tmric(jpi,jpj,jpk), Stat=zdf_ric_alloc) 62 63 IF(zdf_ric_alloc /= 0)THEN 64 CALL ctl_warn('zdf_ric_alloc: failed to allocate arrays.') 65 END IF 66 52 INTEGER FUNCTION zdf_ric_alloc() 53 !!---------------------------------------------------------------------- 54 !! *** FUNCTION zdf_ric_alloc *** 55 !!---------------------------------------------------------------------- 56 ALLOCATE( tmric(jpi,jpj,jpk) , STAT=zdf_ric_alloc ) 57 ! 58 IF( lk_mpp ) CALL mpp_sum ( zdf_ric_alloc ) 59 IF( zdf_ric_alloc /= 0 ) CALL ctl_warn('zdf_ric_alloc: failed to allocate arrays.') 67 60 END FUNCTION zdf_ric_alloc 68 61 … … 196 189 ENDIF 197 190 ! 198 DO jk = 1, jpk ! weighting mean array tmric for 4 T-points which accounts for coastal boundary conditions. 199 DO jj = 2, jpj 191 ! ! allocate zdfric arrays 192 IF( zdf_ric_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_ric_init : unable to allocate arrays' ) 193 ! 194 DO jk = 1, jpk ! weighting mean array tmric for 4 T-points 195 DO jj = 2, jpj ! which accounts for coastal boundary conditions 200 196 DO ji = 2, jpi 201 197 tmric(ji,jj,jk) = tmask(ji,jj,jk) & … … 205 201 END DO 206 202 END DO 207 tmric(:,1,:) = 0. e0203 tmric(:,1,:) = 0._wp 208 204 ! 209 205 DO jk = 1, jpk ! Initialization of vertical eddy coef. to the background value -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r2590 r2616 56 56 PUBLIC zdf_tke_init ! routine called in opa module 57 57 PUBLIC tke_rst ! routine called in step module 58 PUBLIC zdf_tke_alloc ! routine called in nemogcm module59 58 60 59 LOGICAL , PUBLIC, PARAMETER :: lk_zdftke = .TRUE. !: TKE vertical mixing flag 61 62 #if defined key_c1d63 ! !!** 1D cfg only ** ('key_c1d')64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_dis, e_mix !: dissipation and mixing turbulent lengh scales65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_pdl, e_ric !: prandl and local Richardson numbers66 #endif67 60 68 61 ! !!** Namelist namzdf_tke ** … … 88 81 REAL(wp) :: rhftau_scl = 1.0_wp ! scale factor applied to HF part of taum (nn_etau=3) 89 82 90 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PUBLIC :: en ! now turbulent kinetic energy [m2/s2] 91 92 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: htau ! depth of tke penetration (nn_htau) 93 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dissl ! now mixing lenght of dissipation 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy [m2/s2] 84 #if defined key_c1d 85 ! !!** 1D cfg only ** ('key_c1d') 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_dis, e_mix !: dissipation and mixing turbulent lengh scales 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_pdl, e_ric !: prandl and local Richardson numbers 88 #endif 89 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: htau ! depth of tke penetration (nn_htau) 90 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dissl ! now mixing lenght of dissipation 94 91 95 92 !! * Substitutions … … 97 94 # include "vectopt_loop_substitute.h90" 98 95 !!---------------------------------------------------------------------- 99 !! NEMO/OPA 3.3 , NEMO Consortium (2010)96 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 100 97 !! $Id$ 101 98 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 103 100 CONTAINS 104 101 105 FUNCTION zdf_tke_alloc() 106 !!---------------------------------------------------------------------- 107 !! *** ROUTINE zdf_tke_alloc *** 108 !!---------------------------------------------------------------------- 109 IMPLICIT none 110 INTEGER :: zdf_tke_alloc 111 !!---------------------------------------------------------------------- 112 113 ALLOCATE( & 102 INTEGER FUNCTION zdf_tke_alloc() 103 !!---------------------------------------------------------------------- 104 !! *** FUNCTION zdf_tke_alloc *** 105 !!---------------------------------------------------------------------- 106 ALLOCATE( & 114 107 #if defined key_c1d 115 e_dis(jpi,jpj,jpk), e_mix(jpi,jpj,jpk),&116 e_pdl(jpi,jpj,jpk), e_ric(jpi,jpj,jpk),&108 & e_dis(jpi,jpj,jpk) , e_mix(jpi,jpj,jpk) , & 109 & e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) , & 117 110 #endif 118 en(jpi,jpj,jpk), htau(jpi,jpj), dissl(jpi,jpj,jpk), & 119 Stat=zdf_tke_alloc) 120 121 IF(zdf_tke_alloc /= 0)THEN 122 CALL ctl_warn('zdf_tke_alloc: failed to allocate arrays.') 123 END IF 124 111 & en (jpi,jpj,jpk) , htau (jpi,jpj) , dissl(jpi,jpj,jpk) , STAT=zdf_tke_alloc ) 112 ! 113 IF( lk_mpp ) CALL mpp_sum ( zdf_tke_alloc ) 114 IF( zdf_tke_alloc /= 0 ) CALL ctl_warn('zdf_tke_alloc: failed to allocate arrays') 115 ! 125 116 END FUNCTION zdf_tke_alloc 126 117 … … 220 211 !!-------------------------------------------------------------------- 221 212 ! 222 IF( (.NOT. iwrk_use(2,1)) .OR. & 223 (.NOT. wrk_use(2, 1)) .OR. & 224 (.NOT. wrk_use(3, 1)) )THEN 225 CALL ctl_stop('tke_tke : requested workspace arrays unavailable.') 226 RETURN 213 IF( .NOT. iwrk_use(2, 1) .OR. & 214 .NOT. wrk_use(2, 1) .OR. & 215 .NOT. wrk_use(3, 1) )THEN 216 CALL ctl_stop('tke_tke : requested workspace arrays unavailable.') ; RETURN 227 217 END IF 228 218 … … 438 428 END DO 439 429 ENDIF 440 !441 430 CALL lbc_lnk( en, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) 442 431 ! 443 IF( (.NOT. iwrk_release(2,1)) .OR. & 444 (.NOT. wrk_release(2, 1)) .OR. & 445 (.NOT. wrk_release(3, 1)) )THEN 446 CALL ctl_stop('tke_tke : failed to release workspace arrays.') 447 END IF 432 IF( .NOT. iwrk_release(2 ,1) .OR. & 433 .NOT. wrk_release(2, 1) .OR. & 434 .NOT. wrk_release(3, 1) ) CALL ctl_stop( 'tke_tke : failed to release workspace arrays' ) 448 435 ! 449 436 END SUBROUTINE tke_tke … … 724 711 WRITE(numout,*) ' critical Richardson nb with your parameters ri_cri = ', ri_cri 725 712 ENDIF 713 714 ! ! allocate tke arrays 715 IF( zdf_tke_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_tke_init : unable to allocate arrays' ) 726 716 727 717 ! !* Check of some namelist values -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
r2590 r2616 8 8 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 9 9 !!---------------------------------------------------------------------- 10 #if defined key_zdftmx 10 #if defined key_zdftmx || defined key_esopa 11 11 !!---------------------------------------------------------------------- 12 12 !! 'key_zdftmx' Tidal vertical mixing … … 51 51 # include "vectopt_loop_substitute.h90" 52 52 !!---------------------------------------------------------------------- 53 !! NEMO/OPA 3.3 , NEMO Consortium (2010)53 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 54 54 !! $Id$ 55 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 56 !!---------------------------------------------------------------------- 57 55 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 56 !!---------------------------------------------------------------------- 58 57 CONTAINS 59 58 60 FUNCTION zdf_tmx_alloc() 61 !!---------------------------------------------------------------------- 62 !! *** ROUTINE zdf_tmx_alloc *** 63 !!---------------------------------------------------------------------- 64 IMPLICIT none 65 INTEGER :: zdf_tmx_alloc 66 !!---------------------------------------------------------------------- 67 68 ALLOCATE(en_tmx(jpi,jpj), mask_itf(jpi,jpj), az_tmx(jpi,jpj,jpk), & 69 Stat=zdf_tmx_alloc) 70 71 IF(zdf_tmx_alloc /= 0)THEN 72 CALL ctl_warn('zdf_tmx_alloc: failed to allocate arrays.') 73 END IF 74 59 INTEGER FUNCTION zdf_tmx_alloc() 60 !!---------------------------------------------------------------------- 61 !! *** FUNCTION zdf_tmx_alloc *** 62 !!---------------------------------------------------------------------- 63 ALLOCATE(en_tmx(jpi,jpj), mask_itf(jpi,jpj), az_tmx(jpi,jpj,jpk), STAT=zdf_tmx_alloc ) 64 ! 65 IF( lk_mpp ) CALL mpp_sum ( zdf_tmx_alloc ) 66 IF( zdf_tmx_alloc /= 0 ) CALL ctl_warn('zdf_tmx_alloc: failed to allocate arrays') 75 67 END FUNCTION zdf_tmx_alloc 76 68 … … 120 112 121 113 IF(.NOT. wrk_use(2, 1))THEN 122 CALL ctl_stop('zdf_tmx : requested workspace array unavailable.') 123 RETURN 114 CALL ctl_stop('zdf_tmx : requested workspace array unavailable.') ; RETURN 124 115 END IF 125 116 ! ! ----------------------- ! … … 355 346 !! Koch-Larrouy et al. 2007, GRL. 356 347 !!---------------------------------------------------------------------- 357 USE oce , zav_tide => ua ! use uaas workspace358 USE wrk_nemo, ONLY: zem2 => wrk_2d_1, &! read M2 and359 zek1 => wrk_2d_2 !K1 tidal energy360 USE wrk_nemo, ONLY: zkz => wrk_2d_3! total M2, K1 and S2 tidal energy361 USE wrk_nemo, ONLY: zfact => wrk_2d_4! used for vertical structure function362 USE wrk_nemo, ONLY: zhdep => wrk_2d_5! Ocean depth363 USE wrk_nemo, ONLY: zpc => wrk_3d_1! power consumption364 !! 365 INTEGER :: ji, jj, jk! dummy loop indices366 INTEGER :: inum ! temporary logical unit367 REAL(wp) :: ztpc, ze_z ! total power consumption348 USE oce , zav_tide => ua ! ua used as workspace 349 USE wrk_nemo, ONLY: zem2 => wrk_2d_1 ! read M2 and 350 USE wrk_nemo, ONLY: zek1 => wrk_2d_2 ! K1 tidal energy 351 USE wrk_nemo, ONLY: zkz => wrk_2d_3 ! total M2, K1 and S2 tidal energy 352 USE wrk_nemo, ONLY: zfact => wrk_2d_4 ! used for vertical structure function 353 USE wrk_nemo, ONLY: zhdep => wrk_2d_5 ! Ocean depth 354 USE wrk_nemo, ONLY: zpc => wrk_3d_1 ! power consumption 355 !! 356 INTEGER :: ji, jj, jk ! dummy loop indices 357 INTEGER :: inum ! local integer 358 REAL(wp) :: ztpc, ze_z ! local scalars 368 359 !! 369 360 NAMELIST/namzdf_tmx/ rn_htmx, rn_n2min, rn_tfe, rn_me, ln_tmx_itf, rn_tfe_itf 370 361 !!---------------------------------------------------------------------- 371 362 372 IF( (.NOT. wrk_use(2, 1,2,3,4,5)) .OR. (.NOT. wrk_use(3, 1)) )THEN 373 CALL ctl_stop('zdf_tmx_init : requested workspace arrays unavailable.') 374 RETURN 363 IF( .NOT. wrk_use(2, 1,2,3,4,5) .OR. .NOT. wrk_use(3, 1) ) THEN 364 CALL ctl_stop('zdf_tmx_init : requested workspace arrays unavailable.') ; RETURN 375 365 END IF 376 366 … … 391 381 ENDIF 392 382 383 ! ! allocate tmx arrays 384 IF( zdf_tmx_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_tmx_init : unable to allocate tmx arrays' ) 385 393 386 IF( ln_tmx_itf ) THEN ! read the Indonesian Through Flow mask 394 387 CALL iom_open('mask_itf',inum) … … 532 525 ENDIF 533 526 ! 534 IF( (.NOT. wrk_release(2, 1,2,3,4,5)) .OR. (.NOT. wrk_release(3, 1)) )THEN 535 CALL ctl_stop('zdf_tmx_init : failed to release workspace arrays.') 536 END IF 527 IF(.NOT. wrk_release(2, 1,2,3,4,5) .OR. & 528 .NOT. wrk_release(3, 1) ) CALL ctl_stop( 'zdf_tmx_init : failed to release workspace arrays' ) 537 529 ! 538 530 END SUBROUTINE zdf_tmx_init -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r2614 r2616 465 465 !! ** Method : 466 466 !!---------------------------------------------------------------------- 467 #if defined key_diahth || defined key_esopa468 USE diahth, ONLY: dia_hth_alloc469 #endif470 USE diaptr, ONLY: dia_ptr_alloc471 467 USE diawri, ONLY: dia_wri_alloc 472 USE divcur, ONLY: div_cur_alloc473 468 USE dom_oce, ONLY: dom_oce_alloc 474 #if defined key_vvl475 USE domvvl, ONLY: dom_vvl_alloc476 #endif477 USE domwri, ONLY: dom_wri_alloc478 #if defined key_dtasal || defined key_esopa479 USE dtasal, ONLY: dta_sal_alloc480 #endif481 #if defined key_dtatem || defined key_esopa482 USE dtatem, ONLY: dta_tem_alloc483 #endif484 #if defined key_ldfslp || defined key_esopa485 USE dynldf_bilapg,ONLY: dyn_ldf_bilapg_alloc486 #endif487 #if defined key_ldfslp || defined key_esopa488 USE dynldf_iso, ONLY: dyn_ldf_iso_alloc489 #endif490 #if defined key_dynspg_ts || defined key_vvl || defined key_esopa491 USE dynspg_oce, ONLY: dynspg_oce_alloc492 #endif493 USE dynvor, ONLY: dyn_vor_alloc494 469 USE dynzdf_exp, ONLY: dyn_zdf_exp_alloc 495 470 #if defined key_floats || defined key_esopa … … 584 559 USE wrk_nemo, ONLY: wrk_alloc 585 560 USE zdfbfr, ONLY: zdf_bfr_alloc 586 #if defined key_zdfddm || defined key_esopa 587 USE zdfddm, ONLY: zdf_ddm_alloc 588 #endif 589 #if defined key_zdfkpp || defined key_esopa 590 USE zdfkpp, ONLY: zdf_kpp_alloc 591 #endif 592 #if defined key_zdfgls || defined key_esopa 593 USE zdfgls, ONLY: zdf_gls_alloc 594 #endif 595 USE zdfmxl, ONLY: zdf_mxl_alloc 596 USE zdf_oce, ONLY: zdf_oce_alloc 597 #if defined key_zdfric || defined key_esopa 598 USE zdfric, ONLY: zdf_ric_alloc 599 #endif 600 #if defined key_zdftke || defined key_esopa 601 USE zdftke, ONLY: zdf_tke_alloc 602 #endif 603 #if defined key_zdftmx 604 USE zdftmx, ONLY: zdf_tmx_alloc 605 #endif 606 IMPLICIT none 561 607 562 INTEGER :: ierr 608 563 INTEGER :: i … … 611 566 ierr = 0 612 567 613 !! Calls to the _alloc() routines should be in the same order as the614 !! modules are USE'd above615 ! End of ice-related allocations616 ierr = ierr + div_cur_alloc()617 #if defined key_diahth || defined key_esopa618 ierr = ierr + dia_hth_alloc()619 #endif620 ierr = ierr + dia_ptr_alloc()621 568 ierr = ierr + dia_wri_alloc() 622 ierr = ierr + dom_oce_alloc() 623 #if defined key_vvl 624 ierr = ierr + dom_vvl_alloc() 625 #endif 626 ierr = ierr + dom_wri_alloc() 627 #if defined key_dtasal || defined key_esopa 628 ierr = ierr + dta_sal_alloc() 629 #endif 630 #if defined key_ldfslp || defined key_esopa 631 ierr = ierr + dyn_ldf_bilapg_alloc() 632 #endif 633 #if defined key_dtatem || defined key_esopa 634 ierr = ierr + dta_tem_alloc() 635 #endif 636 #if defined key_ldfslp || defined key_esopa 637 ierr = ierr + dyn_ldf_iso_alloc() 638 #endif 639 #if defined key_dynspg_ts || defined key_vvl || defined key_esopa 640 ierr = ierr + dynspg_oce_alloc() 641 #endif 642 ierr = ierr + dyn_vor_alloc() 569 ierr = ierr + dom_oce_alloc() ! ocean domain 570 ierr = ierr + zdf_oce_alloc() ! ocean vertical physics 571 572 573 643 574 ierr = ierr + dyn_zdf_exp_alloc() 644 575 #if defined key_floats || defined key_esopa 645 576 ierr = ierr + flo_oce_alloc() 646 #endif647 #if defined key_floats || defined key_esopa648 577 ierr = ierr + flo_wri_alloc() 649 578 #endif … … 709 638 ierr = ierr + trd_mld_trc_alloc() 710 639 #endif 711 #if defined key_cfc712 ierr = ierr + trc_sms_cfc_alloc()713 #endif714 640 ! ...end of TOP-related alloc routines 715 641 … … 733 659 ierr = ierr + wrk_alloc() 734 660 ierr = ierr + zdf_bfr_alloc() 735 #if defined key_zdfddm || defined key_esopa 736 ierr = ierr + zdf_ddm_alloc() 737 #endif 738 #if defined key_zdfkpp || defined key_esopa 739 ierr = ierr + zdf_kpp_alloc() 740 #endif 741 #if defined key_zdfgls || defined key_esopa 742 ierr = ierr + zdf_gls_alloc() 743 #endif 744 ierr = ierr + zdf_mxl_alloc() 745 ierr = ierr + zdf_oce_alloc() 746 #if defined key_zdfric || defined key_esopa 747 ierr = ierr + zdf_ric_alloc() 748 #endif 749 #if defined key_zdftke || defined key_esopa 750 ierr = ierr + zdf_tke_alloc() 751 #endif 752 #if defined key_zdftmx 753 ierr = ierr + zdf_tmx_alloc() 754 #endif 755 756 IF( lk_mpp ) CALL mpp_sum(ierr) 661 662 IF( lk_mpp ) CALL mpp_sum( ierr ) 757 663 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' ) 758 664 ! … … 761 667 762 668 SUBROUTINE nemo_partition( num_pes ) 763 USE par_oce 764 INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 765 ! Local variables 766 INTEGER, PARAMETER :: nfactmax = 20 767 INTEGER :: nfact ! The no. of factors returned 768 INTEGER :: ierr ! Error flag 769 INTEGER :: i 770 INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are 771 ! closest in value 772 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 773 ierr = 0 774 775 CALL factorise(ifact, nfactmax, nfact, num_pes, ierr) 776 777 IF(nfact <= 1)THEN 778 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 779 WRITE (numout, *) ' : using grid of ',num_pes,' x 1' 780 jpnj = 1 781 jpni = num_pes 782 ELSE 783 ! Search through factors for the pair that are closest in value 784 mindiff = 1000000 785 imin = 1 786 DO i=1,nfact-1,2 787 idiff = ABS(ifact(i) - ifact(i+1)) 788 IF(idiff < mindiff)THEN 789 mindiff = idiff 790 imin = i 791 END IF 792 END DO 793 jpnj = ifact(imin) 794 jpni = ifact(imin + 1) 795 ENDIF 796 jpnij = jpni*jpnj 797 798 WRITE(*,*) 'ARPDBG: jpni = ',jpni,'jpnj = ',jpnj,'jpnij = ',jpnij 799 669 !!---------------------------------------------------------------------- 670 !! *** ROUTINE nemo_partition *** 671 !! 672 !! ** Purpose : 673 !! 674 !! ** Method : 675 !!---------------------------------------------------------------------- 676 USE par_oce 677 INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 678 ! Local variables 679 INTEGER, PARAMETER :: nfactmax = 20 680 INTEGER :: nfact ! The no. of factors returned 681 INTEGER :: ierr ! Error flag 682 INTEGER :: i 683 INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value 684 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 685 !!---------------------------------------------------------------------- 686 687 ierr = 0 688 689 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 690 691 IF( nfact <= 1 ) THEN 692 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 693 WRITE (numout, *) ' : using grid of ',num_pes,' x 1' 694 jpnj = 1 695 jpni = num_pes 696 ELSE 697 ! Search through factors for the pair that are closest in value 698 mindiff = 1000000 699 imin = 1 700 DO i=1,nfact-1,2 701 idiff = ABS(ifact(i) - ifact(i+1)) 702 IF(idiff < mindiff)THEN 703 mindiff = idiff 704 imin = i 705 END IF 706 END DO 707 jpnj = ifact(imin) 708 jpni = ifact(imin + 1) 709 ENDIF 710 jpnij = jpni*jpnj 711 712 WRITE(*,*) 'ARPDBG: jpni = ',jpni,'jpnj = ',jpnj,'jpnij = ',jpnij 713 ! 800 714 END SUBROUTINE nemo_partition 801 715 802 !!====================================================================== 803 804 SUBROUTINE factorise ( ifax, maxfax, nfax, n, ierr ) 805 806 ! Subroutine to return the prime factors of n. 807 ! nfax factors are returned in array ifax which is of maximum 808 ! dimension maxfax. 809 810 IMPLICIT none 811 812 ! Subroutine arguments 813 INTEGER, INTENT(in) :: n, maxfax 814 INTEGER, INTENT(Out) :: ierr, nfax 815 INTEGER, INTENT(out) :: ifax(maxfax) 816 ! Local variables. 817 INTEGER :: i, ifac, l, nu 818 INTEGER, PARAMETER :: ntest = 14 819 INTEGER :: lfax(ntest) 820 821 ! lfax contains the set of allowed factors. 822 data (lfax(i),i=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, & 823 256, 128, 64, 32, 16, 8, 4, 2 / 824 825 ! Clear the error flag and initialise output vars 826 ierr = 0 827 ifax = 1 828 nfax = 0 829 830 ! Find the factors of n. 831 if ( n.eq.1 ) goto 20 832 833 ! nu holds the unfactorised part of the number. 834 ! nfax holds the number of factors found. 835 ! l points to the allowed factor list. 836 ! ifac holds the current factor. 837 838 nu = n 716 717 SUBROUTINE factorise( ifax, maxfax, nfax, n, ierr ) 718 !!---------------------------------------------------------------------- 719 !! *** ROUTINE factorise *** 720 !! 721 !! ** Purpose : return the prime factors of n. 722 !! nfax factors are returned in array ifax which is of 723 !! maximum dimension maxfax. 724 !! ** Method : 725 !!---------------------------------------------------------------------- 726 INTEGER, INTENT(in) :: n, maxfax 727 INTEGER, INTENT(Out) :: ierr, nfax 728 INTEGER, INTENT(out) :: ifax(maxfax) 729 ! Local variables. 730 INTEGER :: i, ifac, l, nu 731 INTEGER, PARAMETER :: ntest = 14 732 INTEGER :: lfax(ntest) 733 734 ! lfax contains the set of allowed factors. 735 data (lfax(i),i=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & 736 & 128, 64, 32, 16, 8, 4, 2 / 737 !!---------------------------------------------------------------------- 738 739 ! Clear the error flag and initialise output vars 740 ierr = 0 741 ifax = 1 839 742 nfax = 0 840 743 841 DO l=ntest,1,-1 842 744 ! Find the factors of n. 745 IF( n == 1 ) GOTO 20 746 747 ! nu holds the unfactorised part of the number. 748 ! nfax holds the number of factors found. 749 ! l points to the allowed factor list. 750 ! ifac holds the current factor. 751 752 nu = n 753 nfax = 0 754 755 DO l = ntest, 1, -1 756 ! 843 757 ifac = lfax(l) 844 758 IF(ifac > nu)CYCLE … … 846 760 ! Test whether the factor will divide. 847 761 848 If ( mod(nu,ifac).eq.0 ) then 849 850 ! Add the factor to the list. 851 852 nfax = nfax+1 853 if ( nfax.gt.maxfax ) then 762 IF( MOD(nu,ifac) == 0 ) THEN 763 ! 764 nfax = nfax+1 ! Add the factor to the list 765 IF( nfax > maxfax ) THEN 854 766 ierr = 6 855 767 write (*,*) 'FACTOR: insufficient space in factor array ',nfax 856 768 return 857 endif769 ENDIF 858 770 ifax(nfax) = ifac 859 771 ! Store the other factor that goes with this one 860 772 nfax = nfax + 1 861 ifax(nfax) = nu /ifac773 ifax(nfax) = nu / ifac 862 774 !WRITE (*,*) 'ARPDBG, factors ',nfax-1,' & ',nfax,' are ', & 863 775 ! ifax(nfax-1),' and ',ifax(nfax) 864 END 865 776 ENDIF 777 ! 866 778 END DO 867 779 868 ! Label 20 is the exit point from the factor search loop. 869 20 continue 870 871 return 872 780 20 CONTINUE ! Label 20 is the exit point from the factor search loop. 781 ! 782 RETURN 783 ! 873 784 END SUBROUTINE factorise 874 785 875 786 !!====================================================================== 876 877 787 END MODULE nemogcm
Note: See TracChangeset
for help on using the changeset viewer.
