Changeset 2683
- Timestamp:
- 2011-03-11T08:48:26+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r2633 r2683 43 43 44 44 PUBLIC dom_zgr ! called by dom_init.F90 45 PUBLIC dom_zgr_alloc ! called by nemo_alloc in nemogcm.F9046 45 47 46 ! !!* Namelist namzgr_sco * … … 72 71 # include "vectopt_loop_substitute.h90" 73 72 !!---------------------------------------------------------------------- 74 !! NEMO/OPA 3.3 , NEMO Consortium (2010)73 !! NEMO/OPA 3.3.1 , NEMO Consortium (2011) 75 74 !! $Id$ 76 75 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 78 77 CONTAINS 79 78 80 FUNCTION dom_zgr_alloc() 81 !!---------------------------------------------------------------------- 82 !! *** FUNCTION dom_zgr_alloc *** 83 !!---------------------------------------------------------------------- 84 INTEGER :: dom_zgr_alloc 85 !!---------------------------------------------------------------------- 86 87 ALLOCATE(gsigw3(jpi,jpj,jpk), gsigt3(jpi,jpj,jpk), & 88 esigt3(jpi,jpj,jpk), esigw3(jpi,jpj,jpk), & 89 esigtu3(jpi,jpj,jpk), esigtv3(jpi,jpj,jpk), & 90 esigtf3(jpi,jpj,jpk), esigwu3(jpi,jpj,jpk), & 91 esigwv3(jpi,jpj,jpk), Stat=dom_zgr_alloc) 92 93 IF(dom_zgr_alloc /= 0)THEN 94 CALL ctl_warn('dom_zgr_alloc: failed to allocate arrays.') 95 END IF 96 97 END FUNCTION dom_zgr_alloc 79 INTEGER FUNCTION dom_zgr_sco_alloc() 80 !!---------------------------------------------------------------------- 81 !! *** FUNCTION dom_zgr_sco_alloc *** 82 !!---------------------------------------------------------------------- 83 ALLOCATE( gsigw3 (jpi,jpj,jpk) , gsigt3 (jpi,jpj,jpk) , & 84 & esigt3 (jpi,jpj,jpk) , esigw3 (jpi,jpj,jpk) , & 85 & esigtu3(jpi,jpj,jpk) , esigtv3(jpi,jpj,jpk) , & 86 & esigtf3(jpi,jpj,jpk) , esigwu3(jpi,jpj,jpk) , & 87 & esigwv3(jpi,jpj,jpk) , STAT=dom_zgr_sco_alloc ) 88 ! 89 IF( lk_mpp ) CALL mpp_sum ( dom_zgr_sco_alloc ) 90 IF( dom_zgr_sco_alloc /= 0 ) CALL ctl_warn('dom_zgr_sco_alloc: failed to allocate arrays.') 91 ! 92 END FUNCTION dom_zgr_sco_alloc 98 93 99 94 … … 619 614 !! - update bathy : meter bathymetry (in meters) 620 615 !!---------------------------------------------------------------------- 621 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released622 USE wrk_nemo, ONLY: zbathy => wrk_2d_1616 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 617 USE wrk_nemo, ONLY: zbathy => wrk_2d_1 623 618 !! 624 619 INTEGER :: ji, jj, jl ! dummy loop indices … … 626 621 !!---------------------------------------------------------------------- 627 622 628 IF(wrk_in_use(2, 1))THEN 629 CALL ctl_stop('zgr_bat_ctl: ERROR: requested workspace array unavailable.') 630 RETURN 631 END IF 623 IF( wrk_in_use(2, 1) ) THEN 624 CALL ctl_stop('zgr_bat_ctl: requested workspace array unavailable') ; RETURN 625 ENDIF 632 626 633 627 IF(lwp) WRITE(numout,*) … … 733 727 ENDIF 734 728 ! 735 IF(wrk_not_released(2, 1))THEN 736 CALL ctl_stop('zgr_bat_ctl: ERROR: failed to release workspace array.') 737 RETURN 738 END IF 729 IF( wrk_not_released(2, 1) ) CALL ctl_stop('zgr_bat_ctl: failed to release workspace array') 739 730 ! 740 731 END SUBROUTINE zgr_bat_ctl … … 753 744 !! (min value = 1 over land) 754 745 !!---------------------------------------------------------------------- 755 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released756 USE wrk_nemo, ONLY: zmbk => wrk_2d_1746 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 747 USE wrk_nemo, ONLY: zmbk => wrk_2d_1 757 748 !! 758 749 INTEGER :: ji, jj ! dummy loop indices 759 750 !!---------------------------------------------------------------------- 760 751 ! 761 IF( wrk_in_use(2, 1))THEN 762 CALL ctl_stop('zgr_bot_level: ERROR - requested 2D workspace unavailable.') 763 RETURN 764 END IF 752 IF( wrk_in_use(2, 1) ) THEN 753 CALL ctl_stop('zgr_bot_level: requested 2D workspace unavailable') ; RETURN 754 ENDIF 765 755 ! 766 756 IF(lwp) WRITE(numout,*) … … 780 770 zmbk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 781 771 ! 782 IF( wrk_not_released(2, 1))THEN 783 CALL ctl_stop('zgr_bot_level: ERROR - failed to release workspace array.') 784 RETURN 785 END IF 772 IF( wrk_not_released(2, 1) ) CALL ctl_stop('zgr_bot_level: failed to release workspace array') 786 773 ! 787 774 END SUBROUTINE zgr_bot_level … … 860 847 !! Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270. 861 848 !!---------------------------------------------------------------------- 862 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released863 USE wrk_nemo, ONLY: zprt => wrk_3d_1849 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 850 USE wrk_nemo, ONLY: zprt => wrk_3d_1 864 851 !! 865 852 INTEGER :: ji, jj, jk ! dummy loop indices … … 873 860 !!--------------------------------------------------------------------- 874 861 ! 875 IF( wrk_in_use(3, 1))THEN 876 CALL ctl_stop('zgr_zps: ERROR - requested workspace unavailable.') 877 RETURN 878 END IF 862 IF( wrk_in_use(3, 1) ) THEN 863 CALL ctl_stop('zgr_zps: requested workspace unavailable.') ; RETURN 864 ENDIF 879 865 880 866 IF(lwp) WRITE(numout,*) … … 884 870 885 871 ll_print = .FALSE. ! Local variable for debugging 886 !! ll_print = .TRUE.887 872 888 873 IF(lwp .AND. ll_print) THEN ! control print of the ocean depth … … 1068 1053 ENDIF 1069 1054 ! 1070 IF( wrk_not_released(3, 1))THEN 1071 CALL ctl_stop('zgr_zps: ERROR - failed to release workspace.') 1072 RETURN 1073 END IF 1055 IF( wrk_not_released(3, 1) ) CALL ctl_stop('zgr_zps: failed to release workspace') 1074 1056 ! 1075 1057 END SUBROUTINE zgr_zps … … 1159 1141 !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 1160 1142 !!---------------------------------------------------------------------- 1161 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released1162 USE wrk_nemo, ONLY: zenv => wrk_2d_1, ztmp => wrk_2d_2, zmsk => wrk_2d_3, &1163 zri => wrk_2d_4, zrj => wrk_2d_5, zhbat => wrk_2d_61164 ! !1143 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 1144 USE wrk_nemo, ONLY: zenv => wrk_2d_1 , ztmp => wrk_2d_2 , zmsk => wrk_2d_3 1145 USE wrk_nemo, ONLY: zri => wrk_2d_4 , zrj => wrk_2d_5 , zhbat => wrk_2d_6 1146 ! 1165 1147 INTEGER :: ji, jj, jk, jl ! dummy loop argument 1166 1148 INTEGER :: iip1, ijp1, iim1, ijm1 ! temporary integers 1167 1149 REAL(wp) :: zcoeft, zcoefw, zrmax, ztaper ! temporary scalars 1168 ! !1150 ! 1169 1151 NAMELIST/namzgr_sco/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, ln_s_sigma, rn_bb, rn_hc 1170 1152 !!---------------------------------------------------------------------- 1171 1153 1172 IF(wrk_in_use(2, 1,2,3,4,5,6))THEN 1173 CALL ctl_stop('zgr_sco: ERROR - requested workspace arrays unavailable') 1174 RETURN 1175 END IF 1176 1177 REWIND( numnam ) ! Read Namelist namzgr_sco : sigma-stretching parameters 1154 IF( wrk_in_use(2, 1,2,3,4,5,6) ) THEN 1155 CALL ctl_stop('zgr_sco: ERROR - requested workspace arrays unavailable') ; RETURN 1156 ENDIF 1157 1158 REWIND( numnam ) ! Read Namelist namzgr_sco : sigma-stretching parameters 1178 1159 READ ( numnam, namzgr_sco ) 1179 1160 1180 IF(lwp) THEN 1161 IF(lwp) THEN ! control print 1181 1162 WRITE(numout,*) 1182 1163 WRITE(numout,*) 'dom:zgr_sco : s-coordinate or hybrid z-s-coordinate' … … 1194 1175 ENDIF 1195 1176 1177 ! ! allocate sco arrays 1178 IF( dom_zgr_sco_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dom:zgr_sco : unable to allocate arrays' ) 1179 1196 1180 gsigw3 = 0._wp ; gsigt3 = 0._wp ; gsi3w3 = 0._wp 1197 1181 esigt3 = 0._wp ; esigw3 = 0._wp … … 1209 1193 DO jj = 1, jpj 1210 1194 DO ji = 1, jpi 1211 IF( bathy(ji,jj) > 0._wp ) THEN 1212 bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) ) 1213 ENDIF 1195 IF( bathy(ji,jj) > 0._wp ) bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) ) 1214 1196 END DO 1215 1197 END DO … … 1616 1598 !!gm bug #endif 1617 1599 ! 1618 IF(wrk_not_released(2, 1,2,3,4,5,6))THEN 1619 CALL ctl_stop('zgr_sco: ERROR - failed to release workspace arrays') 1620 END IF 1600 IF( wrk_not_released(2, 1,2,3,4,5,6) ) CALL ctl_stop('dom:zgr_sco: failed to release workspace arrays') 1621 1601 ! 1622 1602 END SUBROUTINE zgr_sco 1623 1624 1603 1625 1604 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
