Changeset 2625
- Timestamp:
- 2011-02-27T17:36:24+01:00 (13 years ago)
- Location:
- branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 18 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r2618 r2625 97 97 INTEGER, DIMENSION(5) :: ierr 98 98 !!---------------------------------------------------------------------- 99 100 99 ierr(:) = 0 101 100 ! 102 101 ALLOCATE( btmsk(jpi,jpj,nptr) , & 103 & 104 & 105 & 106 & 107 & 108 & 102 & htr_adv(jpj) , str_adv(jpj) , & 103 & htr_ldf(jpj) , str_ldf(jpj) , & 104 & htr_ove(jpj) , str_ove(jpj), & 105 & htr(jpj,nptr) , str(jpj,nptr) , & 106 & tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , & 107 & sjk (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr(1) ) 109 108 ! 110 109 #if defined key_diaeiv … … 112 111 & v_msf_eiv(jpj,jpk,nptr) , STAT=ierr(2) ) 113 112 #endif 114 115 113 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(3)) 116 114 ! 117 115 ALLOCATE(ndex(jpj*jpk), ndex_atl(jpj*jpk), ndex_pac(jpj*jpk), & 118 116 & ndex_ind(jpj*jpk), ndex_ipc(jpj*jpk), & … … 482 480 ENDIF 483 481 484 IF( lk_mpp ) CALL mpp_ini_znl ! Define MPI communicator for zonal sum482 IF( lk_mpp ) CALL mpp_ini_znl( numout ) ! Define MPI communicator for zonal sum 485 483 486 484 IF( ln_subbas ) THEN ! load sub-basin mask -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r2613 r2625 48 48 USE dtatem 49 49 USE dtasal 50 USE lib_mpp ! MPP library 50 51 51 52 IMPLICIT NONE … … 75 76 CONTAINS 76 77 77 FUNCTION dia_wri_alloc()78 INTEGER FUNCTION dia_wri_alloc() 78 79 !!---------------------------------------------------------------------- 79 IMPLICIT none80 INTEGER :: dia_wri_alloc81 80 INTEGER, DIMENSION(2) :: ierr 82 81 !!---------------------------------------------------------------------- … … 89 88 ! 90 89 dia_wri_alloc = MAXVAL(ierr) 91 IF( lk_mpp ) CALL mpp_sum( ierr)90 IF( lk_mpp ) CALL mpp_sum( dia_wri_alloc ) 92 91 ! 93 92 END FUNCTION dia_wri_alloc -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r2618 r2625 336 336 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field) 337 337 IF( nn_cla == 1 ) CALL cla_div ( kt ) ! Cross Land Advection (update hdivn field) 338 339 ! 4. Lateral boundary conditions on hdivn and rotn 340 ! ---------------------------------=======---====== 338 ! 341 339 CALL lbc_lnk( hdivn, 'T', 1. ) ; CALL lbc_lnk( rotn , 'F', 1. ) ! lateral boundary cond. (no sign change) 342 340 ! -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90
r2528 r2625 38 38 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 39 39 !! $Id$ 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 41 !!---------------------------------------------------------------------- 42 43 42 CONTAINS 44 43 … … 58 57 !!---------------------------------------------------------------------- 59 58 ! 60 SELECT CASE ( nadv ) 59 SELECT CASE ( nadv ) ! compute advection trend and add it to general trend 61 60 CASE ( 0 ) 62 61 CALL dyn_keg ( kt ) ! vector form : horizontal gradient of kinetic energy -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
r2590 r2625 29 29 # include "vectopt_loop_substitute.h90" 30 30 !!---------------------------------------------------------------------- 31 !! NEMO/OPA 3.2 , LODYC-IPSL (2009)31 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 32 32 !! $Id$ 33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 34 34 !!---------------------------------------------------------------------- 35 36 35 CONTAINS 37 36 … … 47 46 !! ** Action : (ua,va) updated with the now vorticity term trend 48 47 !!---------------------------------------------------------------------- 49 USE oce, ONLY: zfu => ta ! use ta as 3D workspace 50 USE oce, ONLY: zfv => sa ! use sa as 3D workspace 51 USE wrk_nemo, ONLY: zfu_t => wrk_3d_1, & ! 3D workspaces 52 zfu_f => wrk_3d_2, & 53 zfu_uw =>wrk_3d_3, & 54 zfv_t => wrk_3d_4, & 55 zfv_f => wrk_3d_5, & 56 zfv_vw =>wrk_3d_6, & 57 zfw => wrk_3d_7, & 58 wrk_use, wrk_release 59 IMPLICIT none 48 USE wrk_nemo, ONLY: wrk_use, wrk_release 49 USE oce , ONLY: zfu => ta ! use ta as 3D workspace 50 USE oce , ONLY: zfv => sa ! use sa as 3D workspace 51 USE wrk_nemo, ONLY: zfu_t => wrk_3d_1 , zfv_t => wrk_3d_4 , zfu_uw =>wrk_3d_6 ! 3D workspaces 52 USE wrk_nemo, ONLY: zfu_f => wrk_3d_2 , zfv_f => wrk_3d_5 , zfv_vw =>wrk_3d_7 53 USE wrk_nemo, ONLY: zfw => wrk_3d_3 60 54 !! 61 55 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 65 59 !!---------------------------------------------------------------------- 66 60 67 IF( kt == nit000 ) THEN68 IF(lwp)WRITE(numout,*)69 IF(lwp)WRITE(numout,*) 'dyn_adv_cen2 : 2nd order flux form momentum advection'70 IF(lwp)WRITE(numout,*) '~~~~~~~~~~~~'61 IF( kt == nit000 .AND. lwp ) THEN 62 WRITE(numout,*) 63 WRITE(numout,*) 'dyn_adv_cen2 : 2nd order flux form momentum advection' 64 WRITE(numout,*) '~~~~~~~~~~~~' 71 65 ENDIF 72 66 73 67 ! Check that global workspace arrays aren't already in use 74 IF( .not. wrk_use(3, 1, 2, 3, 4, 5, 6, 7) )THEN 75 IF(lwp) WRITE(numout, *) 'dyn_adv_cen2 : run-time error - global workspace arrays already in use.' 76 CALL ctl_stop('dyn_adv_cen2 : run-time error - global workspace arrays already in use.') 68 IF( .not. wrk_use(3, 1,2,3,4,5,6,7) ) THEN 69 CALL ctl_stop('dyn_adv_cen2 : requested workspace array unavailable') ; RETURN 77 70 END IF 78 71 … … 169 162 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 170 163 ! 171 ! Flag that the global workspace arrays are no longer in use 172 IF( .not. wrk_release(3, 1, 2, 3, 4, 5, 6, 7) )THEN 173 IF(lwp) WRITE(numout, *) 'dyn_adv_cen2 : run-time error - failed to release global workspace arrays.' 174 END IF 164 IF( .not. wrk_release(3, 1,2,3,4,5,6,7) ) CALL ctl_stop('dyn_adv_cen2 : failed to release workspace array') 175 165 ! 176 166 END SUBROUTINE dyn_adv_cen2 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
r2590 r2625 34 34 # include "vectopt_loop_substitute.h90" 35 35 !!---------------------------------------------------------------------- 36 !! NEMO/OPA 3.2 , LODYC-IPSL (2009)36 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 37 37 !! $Id$ 38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 39 !!---------------------------------------------------------------------- 40 38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 39 !!---------------------------------------------------------------------- 41 40 CONTAINS 42 41 … … 68 67 !! Reference : Shchepetkin & McWilliams, 2005, Ocean Modelling. 69 68 !!---------------------------------------------------------------------- 70 USE oce, ONLY: zfu => ta ! use ta as 3D workspace 71 USE oce, ONLY: zfv => sa ! use sa as 3D workspace 72 USE wrk_nemo, ONLY: wrk_use, wrk_release 73 USE wrk_nemo, ONLY: zfu_t =>wrk_3d_1, & 74 zfu_f =>wrk_3d_2, & 75 zfv_t =>wrk_3d_3, & 76 zfv_f =>wrk_3d_4, & 77 zfw =>wrk_3d_5, & 78 zfu_uw =>wrk_3d_6, & 79 zfv_vw =>wrk_3d_7 80 USE wrk_nemo, ONLY: zlu_uu=>wrk_4d_1, & 81 zlu_uv=>wrk_4d_2, & 82 zlv_vv=>wrk_4d_3, & 83 zlv_vu=>wrk_4d_4 84 !! 69 USE wrk_nemo, ONLY: wrk_use, wrk_release 70 USE oce , ONLY: zfu => ta ! ta used as 3D workspace 71 USE oce , ONLY: zfv => sa ! sa used as 3D workspace 72 USE wrk_nemo, ONLY: zfu_t => wrk_3d_1 , zfv_t =>wrk_3d_4 , zfu_uw =>wrk_3d_6 ! 3D workspace 73 USE wrk_nemo, ONLY: zfu_f => wrk_3d_2 , zfv_f =>wrk_3d_5 , zfv_vw =>wrk_3d_7 74 USE wrk_nemo, ONLY: zfw => wrk_3d_3 75 USE wrk_nemo, ONLY: zlu_uu => wrk_4d_1 , zlv_vv=>wrk_4d_3 ! 4D workspace 76 USE wrk_nemo, ONLY: zlu_uv => wrk_4d_2 , zlv_vu=>wrk_4d_4 77 ! 85 78 INTEGER, INTENT(in) :: kt ! ocean time-step index 86 ! !79 ! 87 80 INTEGER :: ji, jj, jk ! dummy loop indices 88 81 REAL(wp) :: zbu, zbv ! temporary scalars 89 82 REAL(wp) :: zui, zvj, zfuj, zfvi, zl_u, zl_v ! temporary scalars 90 ! ARPDBG - arrays below replaced with global work spaces91 !!$ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfu_t, zfu_f ! temporary workspace92 !!$ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfv_t, zfv_f ! " "93 !!$ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfw, zfu_uw, zfv_vw94 !!$ REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: zlu_uu, zlu_uv ! temporary workspace95 !!$ REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: zlv_vv, zlv_vu ! temporary workspace96 83 !!---------------------------------------------------------------------- 97 84 … … 103 90 104 91 ! Check that required workspace arrays are not already in use 105 IF( .not. wrk_use(3, 1, 2, 3, 4, 5, 6, 7) )THEN106 CALL ctl_stop('dyn_adv_ubs : error : required 3d workspace array is already in use')92 IF( .not. wrk_use(3, 1,2,3,4,5,6,7) .AND. .not. wrk_use(4, 1,2,3,4) ) THEN 93 CALL ctl_stop('dyn_adv_ubs : requested workspace array unavailable') ; RETURN 107 94 END IF 108 IF(.not. wrk_use(4, 1, 2, 3, 4) )THEN 109 CALL ctl_stop('dyn_adv_ubs : error : required 4d workspace array is already in use') 110 END IF 111 112 zfu_t(:,:,:) = 0.e0 113 zfv_t(:,:,:) = 0.e0 114 zfu_f(:,:,:) = 0.e0 115 zfv_f(:,:,:) = 0.e0 116 ! 117 zlu_uu(:,:,:,:) = 0.e0 118 zlv_vv(:,:,:,:) = 0.e0 119 zlu_uv(:,:,:,:) = 0.e0 120 zlv_vu(:,:,:,:) = 0.e0 95 96 zfu_t(:,:,:) = 0._wp 97 zfv_t(:,:,:) = 0._wp 98 zfu_f(:,:,:) = 0._wp 99 zfv_f(:,:,:) = 0._wp 100 ! 101 zlu_uu(:,:,:,:) = 0._wp 102 zlv_vv(:,:,:,:) = 0._wp 103 zlu_uv(:,:,:,:) = 0._wp 104 zlv_vu(:,:,:,:) = 0._wp 121 105 122 106 IF( l_trddyn ) THEN ! Save ua and va trends … … 138 122 zlu_uv(ji,jj,jk,1) = ( ub (ji,jj+1,jk)-2.*ub (ji,jj,jk)+ub (ji,jj-1,jk) ) * umask(ji,jj,jk) 139 123 zlv_vu(ji,jj,jk,1) = ( vb (ji+1,jj,jk)-2.*vb (ji,jj,jk)+vb (ji-1,jj,jk) ) * vmask(ji,jj,jk) 140 124 ! 141 125 zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj,jk)-2.*zfu(ji,jj,jk)+zfu(ji-1,jj,jk) ) * umask(ji,jj,jk) 142 126 zlv_vv(ji,jj,jk,2) = ( zfv(ji,jj+1,jk)-2.*zfv(ji,jj,jk)+zfv(ji,jj-1,jk) ) * vmask(ji,jj,jk) … … 147 131 END DO 148 132 !!gm BUG !!! just below this should be +1 in all the communications 149 CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', -1.) ; CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', -1.)150 CALL lbc_lnk( zlu_uu(:,:,:,2), 'U', -1.) ; CALL lbc_lnk( zlu_uv(:,:,:,2), 'U', -1.)151 CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', -1.) ; CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', -1.)152 CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', -1.) ; CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', -1.) 153 133 ! CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', -1.) ; CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', -1.) 134 ! CALL lbc_lnk( zlu_uu(:,:,:,2), 'U', -1.) ; CALL lbc_lnk( zlu_uv(:,:,:,2), 'U', -1.) 135 ! CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', -1.) ; CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', -1.) 136 ! CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', -1.) ; CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', -1.) 137 ! 154 138 !!gm corrected: 155 139 CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', 1. ) ; CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', 1. ) … … 270 254 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 271 255 ! 272 ! Signal that we're done with the 3D and 4D global workspace arrays 273 IF( (.not. wrk_release(3, 1, 2, 3, 4, 5, 6, 7)) .OR. & 274 (.not. wrk_release(4, 1, 2, 3, 4)) )THEN 275 IF(lwp) WRITE(numout,*) 'dyn_adv_ubs : failed to release workspace arrays' 276 END IF 256 IF( .not. wrk_release(3, 1,2,3,4,5,6,7) .OR. & 257 .not. wrk_release(4, 1,2,3,4) ) CALL ctl_stop('dyn_adv_ubs : failed to release workspace array') 277 258 ! 278 259 END SUBROUTINE dyn_adv_ubs -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r2590 r2625 77 77 !!---------------------------------------------------------------------- 78 78 USE wrk_nemo, ONLY: wrk_use, wrk_release 79 USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 79 USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 ! 3D workspace 80 80 !! 81 81 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 83 83 !!---------------------------------------------------------------------- 84 84 ! 85 IF(.NOT. wrk_use(3, 1,2))THEN 86 CALL ctl_stop('dyn_hpg: requested workspace arrays are unavailable.') 87 RETURN 85 IF(.NOT. wrk_use(3, 1,2) ) THEN 86 CALL ctl_stop('dyn_hpg: requested workspace arrays are unavailable') ; RETURN 88 87 END IF 89 88 ! … … 112 111 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 113 112 ! 114 IF(.NOT. wrk_release(3, 1,2))THEN 115 CALL ctl_stop('dyn_hpg: failed to release workspace arrays.') 116 END IF 113 IF(.NOT. wrk_release(3, 1,2) ) CALL ctl_stop('dyn_hpg: failed to release workspace arrays') 117 114 ! 118 115 END SUBROUTINE dyn_hpg … … 606 603 USE oce, ONLY : zhpj => sa ! use sa as 3D workspace 607 604 USE wrk_nemo, ONLY: wrk_use, wrk_release 608 USE wrk_nemo, ONLY: drhox => wrk_3d_1 , dzx => wrk_3d_2609 USE wrk_nemo, ONLY: drhou => wrk_3d_3 , dzu => wrk_3d_4, rho_i => wrk_3d_5610 USE wrk_nemo, ONLY: drhoy => wrk_3d_6 , dzy => wrk_3d_7611 USE wrk_nemo, ONLY: drhov => wrk_3d_8 , dzv => wrk_3d_9, rho_j => wrk_3d_10612 USE wrk_nemo, ONLY: drhoz => wrk_3d_11 , dzz => wrk_3d_12613 USE wrk_nemo, ONLY: drhow => wrk_3d_13 , dzw => wrk_3d_14605 USE wrk_nemo, ONLY: drhox => wrk_3d_1 , dzx => wrk_3d_2 606 USE wrk_nemo, ONLY: drhou => wrk_3d_3 , dzu => wrk_3d_4 , rho_i => wrk_3d_5 607 USE wrk_nemo, ONLY: drhoy => wrk_3d_6 , dzy => wrk_3d_7 608 USE wrk_nemo, ONLY: drhov => wrk_3d_8 , dzv => wrk_3d_9 , rho_j => wrk_3d_10 609 USE wrk_nemo, ONLY: drhoz => wrk_3d_11 , dzz => wrk_3d_12 610 USE wrk_nemo, ONLY: drhow => wrk_3d_13 , dzw => wrk_3d_14 614 611 USE wrk_nemo, ONLY: rho_k => wrk_3d_15 615 612 !! … … 622 619 !!---------------------------------------------------------------------- 623 620 624 IF(.NOT. wrk_use(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15))THEN 625 CALL ctl_stop('dyn:hpg_djc : requested workspace arrays unavailable.') 626 RETURN 621 IF(.NOT. wrk_use(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) ) THEN 622 CALL ctl_stop('dyn:hpg_djc : requested workspace arrays unavailable') ; RETURN 627 623 END IF 628 624 … … 823 819 END DO 824 820 ! 825 IF(.NOT. wrk_release(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) )THEN821 IF(.NOT. wrk_release(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) ) & 826 822 CALL ctl_stop('dyn:hpg_djc : failed to release workspace arrays.') 827 END IF828 823 ! 829 824 END SUBROUTINE hpg_djc … … 841 836 USE oce, ONLY : zhpj => sa ! use sa as 3D workspace 842 837 USE wrk_nemo, ONLY: wrk_use, wrk_release 843 USE wrk_nemo, ONLY: zdistr => wrk_2d_1, zsina => wrk_2d_2, & 844 zcosa => wrk_2d_3 845 USE wrk_nemo, ONLY: zhpiorg => wrk_3d_1, zhpirot => wrk_3d_2 846 USE wrk_nemo, ONLY: zhpitra => wrk_3d_3, zhpine => wrk_3d_4 847 USE wrk_nemo, ONLY: zhpjorg => wrk_3d_5, zhpjrot => wrk_3d_6 848 USE wrk_nemo, ONLY: zhpjtra => wrk_3d_7, zhpjne => wrk_3d_8 838 USE wrk_nemo, ONLY: zdistr => wrk_2d_1 , zsina => wrk_2d_2 , zcosa => wrk_2d_3 839 USE wrk_nemo, ONLY: zhpiorg => wrk_3d_1 , zhpirot => wrk_3d_2 840 USE wrk_nemo, ONLY: zhpitra => wrk_3d_3 , zhpine => wrk_3d_4 841 USE wrk_nemo, ONLY: zhpjorg => wrk_3d_5 , zhpjrot => wrk_3d_6 842 USE wrk_nemo, ONLY: zhpjtra => wrk_3d_7 , zhpjne => wrk_3d_8 849 843 !! 850 844 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 855 849 !!---------------------------------------------------------------------- 856 850 857 IF( (.NOT. wrk_use(2, 1,2,3)) .OR. & 858 (.NOT. wrk_use(3, 1,2,3,4,5,6,7,8)))THEN 859 CALL ctl_stop('dyn:hpg_rot : requested workspace arrays unavailable.') 860 RETURN 851 IF( .NOT. wrk_use(2, 1,2,3) .OR. & 852 .NOT. wrk_use(3, 1,2,3,4,5,6,7,8) ) THEN 853 CALL ctl_stop('dyn:hpg_rot : requested workspace arrays unavailable') ; RETURN 861 854 END IF 862 855 … … 1016 1009 END DO 1017 1010 ! 1018 IF( (.NOT. wrk_release(2, 1,2,3)) .OR. & 1019 (.NOT. wrk_release(3, 1,2,3,4,5,6,7,8)))THEN 1020 CALL ctl_stop('dyn:hpg_rot : failed to release workspace arrays.') 1021 END IF 1011 IF( .NOT. wrk_release(2, 1,2,3) .OR. & 1012 .NOT. wrk_release(3, 1,2,3,4,5,6,7,8) ) CALL ctl_stop('dyn:hpg_rot : failed to release workspace arrays') 1022 1013 ! 1023 1014 END SUBROUTINE hpg_rot -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r2590 r2625 29 29 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 30 30 !! $Id$ 31 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)31 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 32 32 !!---------------------------------------------------------------------- 33 34 33 CONTAINS 35 34 … … 52 51 !! - save this trends (l_trddyn=T) for post-processing 53 52 !!---------------------------------------------------------------------- 54 USE oce, ONLY : ztrdu => ta ! use ta as 3D workspace 55 USE oce, ONLY : ztrdv => sa ! use sa as 3D workspace 56 USE wrk_nemo, ONLY: wrk_use, wrk_release 57 USE wrk_nemo, ONLY: zhke => wrk_3d_1 53 USE wrk_nemo, ONLY: wrk_use, wrk_release 54 USE oce , ONLY: ztrdu => ta , ztrdv => sa ! (ta,sa) used as 3D workspace 55 USE wrk_nemo, ONLY: zhke => wrk_3d_1 ! 3D workspace 58 56 !! 59 57 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 63 61 !!---------------------------------------------------------------------- 64 62 65 IF(.NOT. wrk_use(3,1) )THEN66 CALL ctl_stop('dyn_key: requested workspace array is unavailable.') 67 END 63 IF(.NOT. wrk_use(3,1) ) THEN 64 CALL ctl_stop('dyn_key: requested workspace array is unavailable.') ; RETURN 65 ENDIF 68 66 69 67 IF( kt == nit000 ) THEN … … 88 86 & + vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) 89 87 zhke(ji,jj,jk) = zv + zu 88 !!gm simplier coding ==>> ~ faster 89 ! don't forget to suppress local zu zv scalars 90 ! zhke(ji,jj,jk) = 0.25 * ( un(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 91 ! & + un(ji ,jj ,jk) * un(ji ,jj ,jk) & 92 ! & + vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) & 93 ! & + vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) 94 !!gm end <<== 90 95 END DO 91 96 END DO … … 96 101 END DO 97 102 END DO 103 !!gm idea to be tested ==>> is it faster on scalar computers ? 104 ! DO jj = 2, jpjm1 ! add the gradient of kinetic energy to the general momentum trends 105 ! DO ji = fs_2, fs_jpim1 ! vector opt. 106 ! ua(ji,jj,jk) = ua(ji,jj,jk) - 0.25 * ( + un(ji+1,jj ,jk) * un(ji+1,jj ,jk) & 107 ! & + vn(ji+1,jj-1,jk) * vn(ji+1,jj-1,jk) & 108 ! & + vn(ji+1,jj ,jk) * vn(ji+1,jj ,jk) & 109 ! ! 110 ! & - un(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 111 ! & - vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) & 112 ! & - vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) / e1u(ji,jj) 113 ! ! 114 ! va(ji,jj,jk) = va(ji,jj,jk) - 0.25 * ( un(ji-1,jj+1,jk) * un(ji-1,jj+1,jk) & 115 ! & + un(ji ,jj+1,jk) * un(ji ,jj+1,jk) & 116 ! & + vn(ji ,jj+1,jk) * vn(ji ,jj+1,jk) & 117 ! ! 118 ! & - un(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 119 ! & - un(ji ,jj ,jk) * un(ji ,jj ,jk) & 120 ! & - vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) / e2v(ji,jj) 121 ! END DO 122 ! END DO 123 !!gm en idea <<== 98 124 ! ! =============== 99 125 END DO ! End of slab … … 109 135 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 110 136 ! 111 IF(.NOT. wrk_release(3,1))THEN 112 CALL ctl_stop('dyn_key: failed to release workspace array.') 113 END IF 114 137 IF(.NOT. wrk_release(3, 1) ) CALL ctl_stop('dyn_key: failed to release workspace array') 138 ! 115 139 END SUBROUTINE dyn_keg 116 140 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
r2590 r2625 4 4 !! Ocean dynamics: lateral viscosity trend 5 5 !!====================================================================== 6 !! History : OPA ! 1990-09 (G. Madec) Original code 7 !! 4.0 ! 1993-03 (M. Guyon) symetrical conditions (M. Guyon) 8 !! 6.0 ! 1996-01 (G. Madec) statement function for e3 9 !! 8.0 ! 1997-07 (G. Madec) lbc calls 10 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 11 !! 2.0 ! 2004-08 (C. Talandier) New trends organization 12 !!---------------------------------------------------------------------- 6 13 7 14 !!---------------------------------------------------------------------- … … 9 16 !! using an iso-level bilaplacian operator 10 17 !!---------------------------------------------------------------------- 11 !! * Modules used12 18 USE oce ! ocean dynamics and tracers 13 19 USE dom_oce ! ocean space and time domain … … 31 37 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 32 38 !! $Id$ 33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 34 !!---------------------------------------------------------------------- 35 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 40 !!---------------------------------------------------------------------- 36 41 CONTAINS 37 42 … … 69 74 !! ** Action : - Update (ua,va) with the before iso-level biharmonic 70 75 !! mixing trend. 71 !!72 !! History :73 !! ! 90-09 (G. Madec) Original code74 !! ! 91-11 (G. Madec)75 !! ! 93-03 (M. Guyon) symetrical conditions (M. Guyon)76 !! ! 96-01 (G. Madec) statement function for e377 !! ! 97-07 (G. Madec) lbc calls78 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module79 !! 9.0 ! 04-08 (C. Talandier) New trends organization80 76 !!---------------------------------------------------------------------- 81 77 USE wrk_nemo, ONLY: wrk_use, wrk_release 82 USE wrk_nemo, ONLY: zcu => wrk_2d_1, zcv => wrk_2d_2 83 USE wrk_nemo, ONLY: zuf => wrk_3d_1, zut => wrk_3d_2, & 84 zlu => wrk_3d_3, zlv => wrk_3d_4 85 !! * Arguments 86 INTEGER, INTENT( in ) :: kt ! ocean time-step index 87 88 !! * Local declarations 78 USE wrk_nemo, ONLY: zcu => wrk_2d_1, zcv => wrk_2d_2 ! 3D workspace 79 USE wrk_nemo, ONLY: zuf => wrk_3d_1, zut => wrk_3d_2 ! 3D workspace 80 USE wrk_nemo, ONLY: zlu => wrk_3d_3, zlv => wrk_3d_4 81 ! 82 INTEGER, INTENT(in) :: kt ! ocean time-step index 83 ! 89 84 INTEGER :: ji, jj, jk ! dummy loop indices 90 85 REAL(wp) :: zua, zva, zbt, ze2u, ze2v ! temporary scalar 91 86 !!---------------------------------------------------------------------- 92 !! OPA 8.5, LODYC-IPSL (2002) 93 !!---------------------------------------------------------------------- 94 95 IF( (.NOT. wrk_use(2, 1,2)) .OR. (.NOT. wrk_use(3, 1,2,3,4)) )THEN 96 CALL ctl_stop('dyn_ldf_bilap : requested workspace arrays unavailable.') 97 RETURN 98 END IF 99 100 IF( kt == nit000 ) THEN 101 IF(lwp) WRITE(numout,*) 102 IF(lwp) WRITE(numout,*) 'dyn_ldf_bilap : iso-level bilaplacian operator' 103 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 87 88 IF( .NOT. wrk_use(2, 1,2) .OR. .NOT. wrk_use(3, 1,2,3,4) ) THEN 89 CALL ctl_stop('dyn_ldf_bilap : requested workspace arrays unavailable') ; RETURN 90 ENDIF 91 92 IF( kt == nit000 .AND. lwp ) THEN 93 WRITE(numout,*) 94 WRITE(numout,*) 'dyn_ldf_bilap : iso-level bilaplacian operator' 95 WRITE(numout,*) '~~~~~~~~~~~~~' 104 96 ENDIF 105 97 … … 109 101 !!$ zlu(:,:,jpk) = 0.e0 110 102 !!$ zlv(:,:,jpk) = 0.e0 111 zuf(:,:,:) = 0. e0112 zut(:,:,:) = 0. e0113 zlu(:,:,:) = 0. e0114 zlv(:,:,:) = 0. e0103 zuf(:,:,:) = 0._wp 104 zut(:,:,:) = 0._wp 105 zlu(:,:,:) = 0._wp 106 zlv(:,:,:) = 0._wp 115 107 116 108 ! ! =============== … … 142 134 END DO 143 135 ENDIF 144 ENDDO 145 146 ! Boundary conditions on the laplacian (zlu,zlv) 147 CALL lbc_lnk( zlu, 'U', -1. ) 148 CALL lbc_lnk( zlv, 'V', -1. ) 149 136 END DO 137 CALL lbc_lnk( zlu, 'U', -1. ) ; CALL lbc_lnk( zlv, 'V', -1. ) ! Boundary conditions 138 150 139 151 140 DO jk = 1, jpkm1 … … 219 208 END DO ! End of slab 220 209 ! ! =============== 221 IF( (.NOT. wrk_release(2, 1,2)) .OR. & 222 (.NOT. wrk_release(3, 1,2,3,4)) )THEN 223 CALL ctl_stop('dyn_ldf_bilap : failed to release workspace arrays.') 224 END IF 210 IF( .NOT. wrk_release(2, 1,2) .OR. & 211 .NOT. wrk_release(3, 1,2,3,4) ) CALL ctl_stop('dyn_ldf_bilap : failed to release workspace arrays') 225 212 ! 226 213 END SUBROUTINE dyn_ldf_bilap -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r2613 r2625 20 20 USE lib_print ! formated print library 21 21 USE nc4interface ! NetCDF4 interface 22 USE lib_mpp , ONLY : lk_mpp22 USE lib_mpp ! MPP library 23 23 24 24 IMPLICIT NONE … … 173 173 WRITE(numout,*) 174 174 WRITE(numout,*) 'huge E-R-R-O-R : immediate stop' 175 IF(lk_mpp) CALL mppstop() 176 STOP 175 CALL mppstop() 177 176 ENDIF 178 177 ENDIF -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r2590 r2625 23 23 !! 'key_mpp_mpi' MPI massively parallel processing library 24 24 !!---------------------------------------------------------------------- 25 !! mynode : indentify the processor unit 26 !! mpp_lnk : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d) 25 !! lib_mpp_alloc : allocate mpp arrays 26 !! mynode : indentify the processor unit 27 !! mpp_lnk : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d) 27 28 !! mpp_lnk_3d_gather : Message passing manadgement for two 3D arrays 28 !! mpp_lnk_e : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e)29 !! mpprecv :30 !! mppsend : SUBROUTINE mpp_ini_znl31 !! mppscatter :32 !! mppgather :33 !! mpp_min : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real34 !! mpp_max : generic interface for mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real35 !! mpp_sum : generic interface for mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real36 !! mpp_minloc :37 !! mpp_maxloc :38 !! mppsync :39 !! mppstop :40 !! mppobc : variant of mpp_lnk for open boundary condition29 !! mpp_lnk_e : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e) 30 !! mpprecv : 31 !! mppsend : SUBROUTINE mpp_ini_znl 32 !! mppscatter : 33 !! mppgather : 34 !! mpp_min : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real 35 !! mpp_max : generic interface for mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real 36 !! mpp_sum : generic interface for mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real 37 !! mpp_minloc : 38 !! mpp_maxloc : 39 !! mppsync : 40 !! mppstop : 41 !! mppobc : variant of mpp_lnk for open boundary condition 41 42 !! mpp_ini_north : initialisation of north fold 42 43 !! mpp_lbc_north : north fold processors gathering 43 44 !! mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo 44 45 !!---------------------------------------------------------------------- 45 !! History : 46 !! ! 94 (M. Guyon, J. Escobar, M. Imbard) Original code 47 !! ! 97 (A.M. Treguier) SHMEM additions 48 !! ! 98 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI 49 !! 9.0 ! 03 (J.-M. Molines, G. Madec) F90, free form 50 !! ! 04 (R. Bourdalle Badie) isend option in mpi 51 !! ! 05 (G. Madec, S. Masson) npolj=5,6 F-point & ice cases 52 !! ! 05 (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort 53 !! ! 09 (R. Benshila) SHMEM suppression, north fold in lbc_nfd 46 !! History : OPA ! 1994 (M. Guyon, J. Escobar, M. Imbard) Original code 47 !! ! 1997 (A.M. Treguier) SHMEM additions 48 !! ! 1998 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI 49 !! NEMO 1.0 ! 2003 (J.-M. Molines, G. Madec) F90, free form 50 !! ! 2004 (R. Bourdalle Badie) isend option in mpi 51 !! ! 2005 (G. Madec, S. Masson) npolj=5,6 F-point & ice cases 52 !! ! 2005 (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort 53 !! ! 2009 (R. Benshila) SHMEM suppression, north fold in lbc_nfd 54 54 !!---------------------------------------------------------------------- 55 USE dom_oce ! ocean space and time domain 56 USE in_out_manager ! I/O manager 57 USE lbcnfd ! north fold treatment 55 USE dom_oce ! ocean space and time domain 56 USE lbcnfd ! north fold treatment 58 57 59 58 IMPLICIT NONE … … 117 116 # endif 118 117 118 CHARACTER(lc) :: cform_err = "(/,' ===>>> : E R R O R', /,' ===========',/)" !: 119 CHARACTER(lc) :: cform_war = "(/,' ===>>> : W A R N I N G', /,' ===============',/)" !: 120 119 121 ! variables used in case of sea-ice 120 122 INTEGER, PUBLIC :: ncomm_ice !: communicator made by the processors with sea-ice … … 152 154 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE :: t4ew, t4we ! 2 x 3d for east-west & west-east 153 155 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE :: t4p1, t4p2 ! 2 x 3d for north fold 154 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: t3ns, t3sn ! 3d for north-south & south-north155 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: t3ew, t3we ! 3d for east-west & west-east156 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: t3p1, t3p2 ! 3d for north fold157 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: t2ns, t2sn ! 2d for north-south & south-north158 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: t2ew, t2we ! 2d for east-west & west-east159 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: t2p1, t2p2 ! 2d for north fold160 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: tr2ns, tr2sn! 2d for north-south & south-north + extra outer halo161 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: tr2ew, tr2we! 2d for east-west & west-east + extra outer halo156 REAL(wp), DIMENSION(:,:,:,:) , ALLOCATABLE, SAVE :: t3ns, t3sn ! 3d for north-south & south-north 157 REAL(wp), DIMENSION(:,:,:,:) , ALLOCATABLE, SAVE :: t3ew, t3we ! 3d for east-west & west-east 158 REAL(wp), DIMENSION(:,:,:,:) , ALLOCATABLE, SAVE :: t3p1, t3p2 ! 3d for north fold 159 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2ns, t2sn ! 2d for north-south & south-north 160 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2ew, t2we ! 2d for east-west & west-east 161 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2p1, t2p2 ! 2d for north fold 162 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: tr2ns, tr2sn ! 2d for north-south & south-north + extra outer halo 163 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: tr2ew, tr2we ! 2d for east-west & west-east + extra outer halo 162 164 163 165 ! Arrays used in mpp_lbc_north_3d() 164 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ztab 165 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: znorthloc 166 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: ztab, znorthloc 166 167 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: znorthgloio 167 168 168 169 ! Arrays used in mpp_lbc_north_2d() 169 REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE :: ztab_2d 170 REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE :: znorthloc_2d 170 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: ztab_2d, znorthloc_2d 171 171 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: znorthgloio_2d 172 172 173 173 ! Arrays used in mpp_lbc_north_e() 174 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: ztab_e 175 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: znorthloc_e 174 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: ztab_e, znorthloc_e 176 175 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: znorthgloio_e 177 176 … … 179 178 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 180 179 !! $Id$ 181 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)180 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 182 181 !!---------------------------------------------------------------------- 183 184 182 CONTAINS 185 183 186 FUNCTION lib_mpp_alloc()184 INTEGER FUNCTION lib_mpp_alloc( kumout ) 187 185 !!---------------------------------------------------------------------- 188 186 !! *** routine lib_mpp_alloc *** 189 187 !!---------------------------------------------------------------------- 190 INTEGER :: lib_mpp_alloc191 !!---------------------------------------------------------------------- 192 193 ALLOCATE( t4ns(jpi,jprecj,jpk,2,2), t4sn(jpi,jprecj,jpk,2,2),&194 t4ew(jpj,jpreci,jpk,2,2), t4we(jpj,jpreci,jpk,2,2),&195 t4p1(jpi,jprecj,jpk,2,2), t4p2(jpi,jprecj,jpk,2,2),&196 t3ns(jpi,jprecj,jpk,2), t3sn(jpi,jprecj,jpk,2),&197 t3ew(jpj,jpreci,jpk,2), t3we(jpj,jpreci,jpk,2),&198 t3p1(jpi,jprecj,jpk,2), t3p2(jpi,jprecj,jpk,2),&199 t2ns(jpi,jprecj,2), t2sn(jpi,jprecj,2),&200 t2ew(jpj,jpreci,2), t2we(jpj,jpreci,2),&201 t2p1(jpi,jprecj,2), t2p2(jpi,jprecj,2),&202 tr2ns(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2), &203 tr2sn(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2),&204 tr2ew(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2),&205 tr2we(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2),&206 !207 ztab(jpiglo,4,jpk), znorthloc(jpi,4,jpk), &208 znorthgloio(jpi,4,jpk,jpni), &209 210 ztab_2d(jpiglo,4), znorthloc_2d(jpi,4),&211 znorthgloio_2d(jpi,4,jpni), &212 !213 ztab_e(jpiglo,4+2*jpr2dj),znorthloc_e(jpi,4+2*jpr2dj), &214 znorthgloio_e(jpi,4+2*jpr2dj,jpni), &215 Stat=lib_mpp_alloc)216 217 IF(lib_mpp_alloc /= 0)THEN218 CALL ctl_warn('lib_mpp_alloc : failed to allocate arrays.')219 END 220 188 INTEGER, INTENT(in) :: kumout ! ocean.output logical unit 189 !!---------------------------------------------------------------------- 190 ! 191 ALLOCATE( t4ns(jpi,jprecj,jpk,2,2) , t4sn(jpi,jprecj,jpk,2,2) , & 192 & t4ew(jpj,jpreci,jpk,2,2) , t4we(jpj,jpreci,jpk,2,2) , & 193 & t4p1(jpi,jprecj,jpk,2,2) , t4p2(jpi,jprecj,jpk,2,2) , & 194 & t3ns(jpi,jprecj,jpk,2) , t3sn(jpi,jprecj,jpk,2) , & 195 & t3ew(jpj,jpreci,jpk,2) , t3we(jpj,jpreci,jpk,2) , & 196 & t3p1(jpi,jprecj,jpk,2) , t3p2(jpi,jprecj,jpk,2) , & 197 & t2ns(jpi,jprecj ,2) , t2sn(jpi,jprecj ,2) , & 198 & t2ew(jpj,jpreci ,2) , t2we(jpj,jpreci ,2) , & 199 & t2p1(jpi,jprecj ,2) , t2p2(jpi,jprecj ,2) , & 200 ! 201 & tr2ns(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) , & 202 & tr2sn(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) , & 203 & tr2ew(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) , & 204 & tr2we(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) , & 205 ! 206 & ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) , & 207 ! 208 & ztab_2d(jpiglo,4) , znorthloc_2d(jpi,4) , znorthgloio_2d(jpi,4,jpni) , & 209 ! 210 & ztab_e(jpiglo,4+2*jpr2dj) , znorthloc_e(jpi,4+2*jpr2dj) , znorthgloio_e(jpi,4+2*jpr2dj,jpni) , & 211 ! 212 & STAT=lib_mpp_alloc ) 213 ! 214 IF( lib_mpp_alloc /= 0 ) THEN 215 WRITE(kumout,cform_war) 216 WRITE(kumout,*) 'lib_mpp_alloc : failed to allocate arrays' 217 ENDIF 218 ! 221 219 END FUNCTION lib_mpp_alloc 222 220 223 221 224 FUNCTION mynode( ldtxt, localComm)222 FUNCTION mynode( ldtxt, kumnam, kstop, localComm ) 225 223 !!---------------------------------------------------------------------- 226 224 !! *** routine mynode *** 227 225 !! 228 226 !! ** Purpose : Find processor unit 229 !!230 227 !!---------------------------------------------------------------------- 231 228 CHARACTER(len=*),DIMENSION(:), INTENT( out) :: ldtxt 229 INTEGER , INTENT(in ) :: kumnam ! namelist logical unit 230 INTEGER , INTENT(inout) :: kstop ! stop indicator 232 231 INTEGER, OPTIONAL , INTENT(in ) :: localComm 232 ! 233 233 INTEGER :: mynode, ierr, code, ji, ii 234 234 LOGICAL :: mpi_was_called 235 235 ! 236 236 NAMELIST/nammpp/ cn_mpi_send, nn_buffer 237 237 !!---------------------------------------------------------------------- … … 242 242 WRITE(ldtxt(ii),*) '~~~~~~ ' ; ii = ii + 1 243 243 ! 244 REWIND( numnam ) ! Namelist namrun : parameters of the run245 READ ( numnam, nammpp )244 REWIND( kumnam ) ! Namelist namrun : parameters of the run 245 READ ( kumnam, nammpp ) 246 246 ! ! control print 247 247 WRITE(ldtxt(ii),*) ' Namelist nammpp' ; ii = ii + 1 … … 273 273 WRITE(ldtxt(ii),cform_err) ; ii = ii + 1 274 274 WRITE(ldtxt(ii),*) ' bad value for cn_mpi_send = ', cn_mpi_send ; ii = ii + 1 275 nstop = nstop + 1275 kstop = kstop + 1 276 276 END SELECT 277 277 ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 278 278 WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator ' ; ii = ii + 1 279 279 WRITE(ldtxt(ii),*) ' without calling MPI_Init before ! ' ; ii = ii + 1 280 nstop = nstop + 1280 kstop = kstop + 1 281 281 ELSE 282 282 SELECT CASE ( cn_mpi_send ) … … 294 294 WRITE(ldtxt(ii),cform_err) ; ii = ii + 1 295 295 WRITE(ldtxt(ii),*) ' bad value for cn_mpi_send = ', cn_mpi_send ; ii = ii + 1 296 nstop = nstop + 1296 kstop = kstop + 1 297 297 END SELECT 298 298 ! … … 1706 1706 1707 1707 1708 SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij )1708 SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij , kumout) 1709 1709 !!---------------------------------------------------------------------- 1710 1710 !! *** routine mppobc *** … … 1726 1726 !! 1727 1727 !!---------------------------------------------------------------------- 1728 USE wrk_nemo, ONLY: wrk_use, wrk_release 1729 USE wrk_nemo, ONLY: ztab => wrk_2d_1 1728 USE wrk_nemo, ONLY: wrk_use, wrk_release 1729 USE wrk_nemo, ONLY: ztab => wrk_2d_1 1730 ! 1730 1731 INTEGER , INTENT(in ) :: kd1, kd2 ! starting and ending indices 1731 1732 INTEGER , INTENT(in ) :: kl ! index of open boundary … … 1734 1735 ! ! = 1 north/south ; = 2 east/west 1735 1736 INTEGER , INTENT(in ) :: kij ! horizontal dimension 1737 INTEGER , INTENT(in ) :: kumout ! ocean.output logical unit 1736 1738 REAL(wp), INTENT(inout), DIMENSION(kij,kk) :: ptab ! variable array 1737 ! !1738 INTEGER :: ji, jj, jk, jl! dummy loop indices1739 INTEGER :: iipt0, iipt1, ilpt1 ! temporaryintegers1740 INTEGER :: ijpt0, ijpt1 ! --1741 INTEGER :: imigr, iihom, ijhom ! --1739 ! 1740 INTEGER :: ji, jj, jk, jl ! dummy loop indices 1741 INTEGER :: iipt0, iipt1, ilpt1 ! local integers 1742 INTEGER :: ijpt0, ijpt1 ! - - 1743 INTEGER :: imigr, iihom, ijhom ! - - 1742 1744 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 1743 1745 INTEGER :: ml_stat(MPI_STATUS_SIZE) ! for key_mpi_isend 1744 1746 !!---------------------------------------------------------------------- 1745 1747 1746 IF(.NOT. wrk_use(2, 1))THEN 1747 CALL ctl_stop('mppobc : requested workspace array unavailable.') 1748 RETURN 1748 IF(.NOT. wrk_use(2, 1) ) THEN 1749 WRITE(kumout, cform_err) 1750 WRITE(kumout,*) 'mppobc : requested workspace array unavailable' 1751 CALL mppstop 1749 1752 END IF 1750 1753 … … 1766 1769 ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj ) ) 1767 1770 ELSE 1768 CALL ctl_stop( 'mppobc: bad ktype' ) 1771 WRITE(kumout, cform_err) 1772 WRITE(kumout,*) 'mppobc : bad ktype' 1773 CALL mppstop 1769 1774 ENDIF 1770 1775 … … 1896 1901 END DO 1897 1902 ! 1898 IF(.NOT. wrk_release(2, 1))THEN 1899 CALL ctl_stop('mppobc : failed to release workspace array.') 1900 END IF 1903 IF(.NOT. wrk_release(2, 1) ) THEN 1904 WRITE(kumout, cform_err) 1905 WRITE(kumout,*) 'mppobc : failed to release workspace array' 1906 CALL mppstop 1907 ENDIF 1901 1908 ! 1902 1909 END SUBROUTINE mppobc … … 1916 1923 1917 1924 1918 SUBROUTINE mpp_ini_ice( pindic )1925 SUBROUTINE mpp_ini_ice( pindic, kumout ) 1919 1926 !!---------------------------------------------------------------------- 1920 1927 !! *** routine mpp_ini_ice *** … … 1938 1945 !! 1939 1946 !!---------------------------------------------------------------------- 1940 INTEGER, INTENT(in) :: pindic1941 !!1942 INTEGER :: ierr1947 INTEGER, INTENT(in) :: pindic 1948 INTEGER, INTENT(in) :: kumout ! ocean.output logical unit 1949 !! 1943 1950 INTEGER :: jjproc 1944 INTEGER :: ii 1945 INTEGER, ALLOCATABLE, DIMENSION(:) :: kice1946 INTEGER, ALLOCATABLE, DIMENSION(:) :: zwork1951 INTEGER :: ii, ierr 1952 INTEGER, ALLOCATABLE, DIMENSION(:) :: kice 1953 INTEGER, ALLOCATABLE, DIMENSION(:) :: zwork 1947 1954 !!---------------------------------------------------------------------- 1948 1955 ! 1949 1956 ! Since this is just an init routine and these arrays are of length jpnij 1950 1957 ! then don't use wrk_nemo module - just allocate and deallocate. 1951 ALLOCATE(kice(jpnij), zwork(jpnij), Stat=ierr) 1952 IF(ierr /= 0)THEN 1953 CALL ctl_stop('mpp_ini_ice : failed to allocate 2, 1D arrays (jpnij in length).') 1954 RETURN 1958 ALLOCATE( kice(jpnij), zwork(jpnij), STAT=ierr ) 1959 IF( ierr /= 0 ) THEN 1960 WRITE(kumout, cform_err) 1961 WRITE(kumout,*) 'mpp_ini_ice : failed to allocate 2, 1D arrays (jpnij in length)' 1962 CALL mppstop 1955 1963 ENDIF 1956 1964 … … 1996 2004 ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr) 1997 2005 ! 1998 1999 2006 DEALLOCATE(kice, zwork) 2000 2007 ! 2001 2008 END SUBROUTINE mpp_ini_ice 2002 2009 2003 2010 2004 SUBROUTINE mpp_ini_znl 2011 SUBROUTINE mpp_ini_znl ( kumout ) 2005 2012 !!---------------------------------------------------------------------- 2006 2013 !! *** routine mpp_ini_znl *** … … 2021 2028 !! 2022 2029 !!---------------------------------------------------------------------- 2023 INTEGER :: ierr 2024 INTEGER :: jproc 2025 INTEGER :: ii 2026 INTEGER, ALLOCATABLE, DIMENSION(:) :: kwork 2027 ! 2030 INTEGER, INTENT(in) :: kumout ! ocean.output logical units 2031 ! 2032 INTEGER :: jproc ! dummy loop integer 2033 INTEGER :: ierr, ii ! local integer 2034 INTEGER, ALLOCATABLE, DIMENSION(:) :: kwork 2035 !!---------------------------------------------------------------------- 2028 2036 !-$$ WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world : ', ngrp_world 2029 2037 !-$$ WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world 2030 2038 !-$$ WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_opa : ', mpi_comm_opa 2031 2039 ! 2032 ALLOCATE(kwork(jpnij), Stat=ierr) 2033 IF(ierr /= 0)THEN 2034 CALL ctl_stop('mpp_ini_znl : failed to allocate 1D array of length jpnij') 2035 RETURN 2036 END IF 2037 2038 IF ( jpnj == 1 ) THEN 2040 ALLOCATE( kwork(jpnij), STAT=ierr ) 2041 IF( ierr /= 0 ) THEN 2042 WRITE(kumout, cform_err) 2043 WRITE(kumout,*) 'mpp_ini_znl : failed to allocate 1D array of length jpnij' 2044 CALL mppstop 2045 ENDIF 2046 2047 IF( jpnj == 1 ) THEN 2039 2048 ngrp_znl = ngrp_world 2040 2049 ncomm_znl = mpi_comm_opa … … 2411 2420 ! Buffer allocation and attachment 2412 2421 ALLOCATE( tampon(nn_buffer), stat = ierr ) 2413 IF (ierr /= 0) THEN2422 IF( ierr /= 0 ) THEN 2414 2423 DO ji = 1, SIZE(ldtxt) 2415 2424 IF( TRIM(ldtxt(ji)) /= '' ) WRITE(*,*) ldtxt(ji) ! control print of mynode … … 2485 2494 CONTAINS 2486 2495 2496 INTEGER FUNCTION lib_mpp_alloc() ! Dummy function 2497 lib_mpp_alloc = 0 2498 END FUNCTION lib_mpp_alloc 2499 2487 2500 FUNCTION mynode( ldtxt, localComm ) RESULT (function_value) 2488 2501 CHARACTER(len=*),DIMENSION(:), INTENT( out) :: ldtxt -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC/obcrad.F90
r2528 r2625 12 12 !! obc_rad_south : compute the south phase velocities 13 13 !!--------------------------------------------------------------------------------- 14 !! * Modules used15 14 USE oce ! ocean dynamics and tracers variables 16 15 USE dom_oce ! ocean space and time domain variables … … 24 23 PRIVATE 25 24 26 !! * Accessibility 27 PUBLIC obc_rad ! routine called by step.F90 28 29 !! * Module variables 25 PUBLIC obc_rad ! routine called by step.F90 26 30 27 INTEGER :: ji, jj, jk ! dummy loop indices 31 28 … … 69 66 !! J. Molines and G. Madec version 70 67 !!------------------------------------------------------------------------------ 71 !! * Arguments72 68 INTEGER, INTENT( in ) :: kt 73 69 !!---------------------------------------------------------------------- … … 143 139 END DO 144 140 END DO 145 IF( lk_mpp ) CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj )141 IF( lk_mpp ) CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj, numout ) 146 142 147 143 ! ... extremeties nie0, nie1 … … 185 181 END DO 186 182 END DO 187 IF( lk_mpp ) CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj )183 IF( lk_mpp ) CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj, numout ) 188 184 189 185 !... extremeties nie0, nie1 … … 226 222 END DO 227 223 END DO 228 IF( lk_mpp ) CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj )229 IF( lk_mpp ) CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj )224 IF( lk_mpp ) CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout ) 225 IF( lk_mpp ) CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout ) 230 226 231 227 ! ... extremeties nie0, nie1 … … 327 323 END DO 328 324 END DO 329 IF( lk_mpp ) CALL mppobc(v_cxebnd,jpjed,jpjef,jpieob+1,jpk,2,jpj )325 IF( lk_mpp ) CALL mppobc(v_cxebnd,jpjed,jpjef,jpieob+1,jpk,2,jpj, numout ) 330 326 331 327 ! ... extremeties nie0, nie1 … … 409 405 END DO 410 406 END DO 411 IF( lk_mpp ) CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj )407 IF( lk_mpp ) CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout ) 412 408 413 409 ! ... extremeties niw0, niw1 … … 451 447 END DO 452 448 END DO 453 IF( lk_mpp ) CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj )449 IF( lk_mpp ) CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout ) 454 450 455 451 ! ... extremeties niw0, niw1 … … 492 488 END DO 493 489 END DO 494 IF( lk_mpp ) CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj )495 IF( lk_mpp ) CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj )490 IF( lk_mpp ) CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout ) 491 IF( lk_mpp ) CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout ) 496 492 497 493 ! ... extremeties niw0, niw1 … … 596 592 END DO 597 593 END DO 598 IF( lk_mpp ) CALL mppobc(v_cxwbnd,jpjwd,jpjwf,jpiwob,jpk,2,jpj )594 IF( lk_mpp ) CALL mppobc(v_cxwbnd,jpjwd,jpjwf,jpiwob,jpk,2,jpj, numout ) 599 595 600 596 ! ... extremeties niw0, niw1 … … 673 669 END DO 674 670 END DO 675 IF( lk_mpp ) CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi )671 IF( lk_mpp ) CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi, numout ) 676 672 677 673 ! ... extremeties njn0,njn1 … … 720 716 END DO 721 717 END DO 722 IF( lk_mpp ) CALL mppobc(vnbnd,jpind,jpinf,jpjnob,jpk*3*3,1,jpi )718 IF( lk_mpp ) CALL mppobc(vnbnd,jpind,jpinf,jpjnob,jpk*3*3,1,jpi, numout ) 723 719 724 720 ! ... extremeties njn0,njn1 … … 761 757 END DO 762 758 END DO 763 IF( lk_mpp ) CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi )764 IF( lk_mpp ) CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi )759 IF( lk_mpp ) CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout ) 760 IF( lk_mpp ) CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout ) 765 761 766 762 ! ... extremeties njn0,njn1 … … 828 824 END DO 829 825 END DO 830 IF( lk_mpp ) CALL mppobc(u_cynbnd,jpind,jpinf,jpjnob+1,jpk,1,jpi )826 IF( lk_mpp ) CALL mppobc(u_cynbnd,jpind,jpinf,jpjnob+1,jpk,1,jpi, numout ) 831 827 832 828 ! ... extremeties njn0,njn1 … … 947 943 END DO 948 944 END DO 949 IF( lk_mpp ) CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi )945 IF( lk_mpp ) CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout ) 950 946 951 947 ! ... extremeties njs0,njs1 … … 992 988 END DO 993 989 END DO 994 IF( lk_mpp ) CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi )990 IF( lk_mpp ) CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout ) 995 991 996 992 ! ... extremeties njs0,njs1 … … 1033 1029 END DO 1034 1030 END DO 1035 IF( lk_mpp ) CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi )1036 IF( lk_mpp ) CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi )1031 IF( lk_mpp ) CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout ) 1032 IF( lk_mpp ) CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout ) 1037 1033 1038 1034 ! ... extremeties njs0,njs1 … … 1100 1096 END DO 1101 1097 END DO 1102 IF( lk_mpp ) CALL mppobc(u_cysbnd,jpisd,jpisf,jpjsob,jpk,1,jpi )1098 IF( lk_mpp ) CALL mppobc(u_cysbnd,jpisd,jpisf,jpjsob,jpk,1,jpi, numout ) 1103 1099 1104 1100 ! ... extremeties njs0,njs1 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90
r2528 r2625 7 7 8 8 !!--------------------------------------------------------------------------------- 9 !! * Modules used10 9 USE oce ! ocean dynamics and tracers variables 11 10 USE dom_oce ! ocean space and time domain variables … … 19 18 PRIVATE 20 19 21 !! * Accessibility 22 PUBLIC obc_rst_read ! routine called by obc_ini 23 PUBLIC obc_rst_write ! routine called by step 24 25 !!--------------------------------------------------------------------------------- 20 PUBLIC obc_rst_read ! routine called by obc_ini 21 PUBLIC obc_rst_write ! routine called by step 22 23 !!---------------------------------------------------------------------- 26 24 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 27 25 !! $Id$ 28 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)29 !!---------------------------------------------------------------------- -----------26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 27 !!---------------------------------------------------------------------- 30 28 31 29 CONTAINS … … 565 563 IF( lk_mpp ) THEN 566 564 IF( lp_obc_east ) THEN 567 CALL mppobc(uebnd,jpjed,jpjef,jpieob ,jpk*3*3,2,jpj)568 CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj )569 CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj )570 CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj )565 CALL mppobc(uebnd,jpjed,jpjef,jpieob ,jpk*3*3,2,jpj, numout ) 566 CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj, numout ) 567 CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout ) 568 CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout ) 571 569 ENDIF 572 570 IF( lp_obc_west ) THEN 573 CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj )574 CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj )575 CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj )576 CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj )571 CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout ) 572 CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout ) 573 CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout ) 574 CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout ) 577 575 ENDIF 578 576 IF( lp_obc_north ) THEN 579 CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi )580 CALL mppobc(vnbnd,jpind,jpinf,jpjnob ,jpk*3*3,1,jpi )581 CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi )582 CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi )577 CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi, numout ) 578 CALL mppobc(vnbnd,jpind,jpinf,jpjnob ,jpk*3*3,1,jpi, numout ) 579 CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout ) 580 CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout ) 583 581 ENDIF 584 582 IF( lp_obc_south ) THEN 585 CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi )586 CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi )587 CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi )588 CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi )583 CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout ) 584 CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout ) 585 CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout ) 586 CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout ) 589 587 ENDIF 590 588 ENDIF -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90
r2620 r2625 18 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 19 USE in_out_manager ! I/O manager 20 USE lib_mpp ! MPP library 20 21 21 22 IMPLICIT NONE -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r2623 r2625 24 24 USE diaptr ! poleward transport diagnostics 25 25 USE trc_oce ! share passive tracers/Ocean variables 26 USE lib_mpp ! MPP library 26 27 27 28 IMPLICIT NONE -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r2623 r2625 204 204 IF( Agrif_Root() ) THEN 205 205 # if defined key_oasis3 || defined key_oasis4 206 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis206 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 207 207 # endif 208 CALL init_ioclient( ilocal_comm ) ! exchange io_server nemo local communicator with the io_server209 ENDIF 210 narea = mynode( cltxt, ilocal_comm )! Nodes selection208 CALL init_ioclient( ilocal_comm ) ! exchange io_server nemo local communicator with the io_server 209 ENDIF 210 narea = mynode( cltxt, numnam, nstop, ilocal_comm ) ! Nodes selection 211 211 #else 212 212 # if defined key_oasis3 || defined key_oasis4 213 213 IF( Agrif_Root() ) THEN 214 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis215 ENDIF 216 narea = mynode( cltxt, ilocal_comm )! Nodes selection (control print return in cltxt)214 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 215 ENDIF 216 narea = mynode( cltxt, numnam, nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 217 217 # else 218 218 ilocal_comm = 0 219 narea = mynode( cltxt ) ! Nodes selection (control print return in cltxt)219 narea = mynode( cltxt numnam, nstop ) ! Nodes selection (control print return in cltxt) 220 220 # endif 221 221 #endif 222 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 )223 224 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print222 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) 223 224 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 225 225 226 226 ! Decide on size of grid now that we have our communicator size … … 469 469 USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc 470 470 USE ldftra_oce, ONLY: ldftra_oce_alloc 471 USE trc_oce, ONLY: trc_oce_alloc 471 472 472 473 473 #if defined key_mpp_mpi474 USE lib_mpp, ONLY: lib_mpp_alloc475 #endif476 474 #if defined key_obc 477 475 USE obcdta , ONLY: obc_dta_alloc … … 510 508 ! ...end of LOBSTER-related alloc routines 511 509 512 USE trc_oce, ONLY: trc_oce_alloc513 510 #if defined key_trdmld || defined key_esopa 514 511 USE trdmld, ONLY: trd_mld_alloc … … 527 524 !!---------------------------------------------------------------------- 528 525 529 ierr = oce_alloc () ! ocean526 ierr = oce_alloc () ! ocean 530 527 ierr = ierr + dia_wri_alloc () 531 ierr = ierr + dom_oce_alloc () ! ocean domain 532 ierr = ierr + ldfdyn_oce_alloc() ! ocean lateral physics : dynamics 533 ierr = ierr + ldftra_oce_alloc() ! ocean lateral physics : tracers 534 ierr = ierr + zdf_oce_alloc() ! ocean vertical physics 535 536 537 538 #if defined key_mpp_mpi 539 ierr = ierr + lib_mpp_alloc() 540 #endif 528 ierr = ierr + dom_oce_alloc () ! ocean domain 529 ierr = ierr + ldfdyn_oce_alloc() ! ocean lateral physics : dynamics 530 ierr = ierr + ldftra_oce_alloc() ! ocean lateral physics : tracers 531 ierr = ierr + zdf_oce_alloc () ! ocean vertical physics 532 ! 533 ierr = ierr + lib_mpp_alloc (numout) ! mpp exchanges 534 ierr = ierr + trc_oce_alloc () ! shared TRC / TRA arrays 535 536 541 537 #if defined key_obc 542 538 ierr = ierr + obc_dta_alloc() … … 572 568 ! ...end of LOBSTER-related alloc routines 573 569 574 ierr = ierr + trc_oce_alloc()575 570 #if defined key_trdmld || defined key_esopa 576 571 ierr = ierr + trd_mld_alloc() -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/oce.F90
r2618 r2625 57 57 INTEGER FUNCTION oce_alloc() 58 58 !!---------------------------------------------------------------------- 59 !! *** FUNCTION oce_alloc *** 60 !!---------------------------------------------------------------------- 59 61 INTEGER :: ierr(2) 60 62 !!---------------------------------------------------------------------- … … 81 83 & gru(jpi,jpj) , grv(jpi,jpj) , STAT=ierr(2) ) 82 84 ! 83 oce_alloc = maxval( ierr )85 oce_alloc = MAXVAL( ierr ) 84 86 IF( oce_alloc /= 0 ) CALL ctl_warn('oce_alloc: failed to allocate arrays') 85 87 ! -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
r2590 r2625 54 54 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 55 55 !! $Id$ 56 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 57 !!---------------------------------------------------------------------- 58 56 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 57 !!---------------------------------------------------------------------- 59 58 CONTAINS 60 59 61 FUNCTION trc_oce_alloc() 62 !!---------------------------------------------------------------------- 63 IMPLICIT none 64 INTEGER :: trc_oce_alloc 65 !!---------------------------------------------------------------------- 66 67 ALLOCATE(etot3(jpi,jpj,jpk), Stat = trc_oce_alloc) 68 69 IF(trc_oce_alloc /= 0)THEN 70 CALL ctl_warn('trc_oce_alloc: failed to allocate array etot3.') 71 END IF 72 60 INTEGER FUNCTION trc_oce_alloc() 61 !!---------------------------------------------------------------------- 62 !! *** trc_oce_alloc *** 63 !!---------------------------------------------------------------------- 64 ALLOCATE( etot3(jpi,jpj,jpk), Stat = trc_oce_alloc ) 65 ! 66 IF( trc_oce_alloc /= 0 ) CALL ctl_warn('trc_oce_alloc: failed to allocate array etot3') 73 67 END FUNCTION trc_oce_alloc 68 74 69 75 70 SUBROUTINE trc_oce_rgb( prgb ) … … 265 260 END FUNCTION trc_oce_ext_lev 266 261 267 268 262 !!====================================================================== 269 263 END MODULE trc_oce
Note: See TracChangeset
for help on using the changeset viewer.