Changeset 2618 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA
- Timestamp:
- 2011-02-26T13:31:38+01:00 (13 years ago)
- Location:
- branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA
- Files:
-
- 2 edited
-
diahth.F90 (modified) (2 diffs)
-
diaptr.F90 (modified) (23 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
r2613 r2618 57 57 ! 58 58 END FUNCTION dia_hth_alloc 59 59 60 60 61 SUBROUTINE dia_hth( kt ) … … 104 105 105 106 IF( kt == nit000 ) THEN 107 ! ! allocate dia_hth array 108 IF( dia_hth_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate standard arrays' ) 106 109 107 110 IF(.not. ALLOCATED(ik20))THEN 108 111 ALLOCATE(ik20(jpi,jpj), ik28(jpi,jpj), & 109 zabs2(jpi,jpj), &110 ztm2(jpi,jpj), &111 zrho10_3(jpi,jpj),&112 zpycn(jpi,jpj), &113 ztinv(jpi,jpj), &114 zdepinv(jpi,jpj), &115 zrho0_3(jpi,jpj), &116 zrho0_1(jpi,jpj), &117 zmaxdzT(jpi,jpj), &118 zthick(jpi,jpj), &119 zdelr(jpi,jpj), STAT=ji)112 & zabs2(jpi,jpj), & 113 & ztm2(jpi,jpj), & 114 & zrho10_3(jpi,jpj),& 115 & zpycn(jpi,jpj), & 116 & ztinv(jpi,jpj), & 117 & zdepinv(jpi,jpj), & 118 & zrho0_3(jpi,jpj), & 119 & zrho0_1(jpi,jpj), & 120 & zmaxdzT(jpi,jpj), & 121 & zthick(jpi,jpj), & 122 & zdelr(jpi,jpj), STAT=ji) 120 123 IF( lk_mpp ) CALL mpp_sum(ji) 121 124 IF( ji /= 0 ) CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard ocean arrays' ) -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r2590 r2618 41 41 PUBLIC ptr_vj ! call by tra_ldf & tra_adv routines 42 42 PUBLIC ptr_vjk ! call by tra_ldf & tra_adv routines 43 PUBLIC dia_ptr_alloc ! call in nemogcm module44 43 45 44 ! !!** namelist namptr ** … … 51 50 INTEGER , PUBLIC :: nn_fwri = 15 !: frequency of ptr outputs [time step] 52 51 53 REAL(wp), PUBLIC, DIMENSION(:), ALLOCATABLE:: htr_adv, htr_ldf, htr_ove !: Heat TRansports (adv, diff, overturn.)54 REAL(wp), PUBLIC, DIMENSION(:), ALLOCATABLE:: str_adv, str_ldf, str_ove !: Salt TRansports (adv, diff, overturn.)52 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: htr_adv, htr_ldf, htr_ove !: Heat TRansports (adv, diff, overturn.) 53 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: str_adv, str_ldf, str_ove !: Salt TRansports (adv, diff, overturn.) 55 54 56 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: btmsk ! T-point basin interior masks 57 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: btm30 ! mask out Southern Ocean (=0 south of 30°S) 58 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: htr , str ! adv heat and salt transports (approx) 59 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tn_jk, sn_jk , v_msf ! i-mean T and S, j-Stream-Function 60 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: sjk , r1_sjk ! i-mean i-k-surface and its inverse 61 #if defined key_diaeiv 62 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: htr_eiv, str_eiv ! bolus adv heat ans salt transports ('key_diaeiv') 63 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: v_msf_eiv ! bolus j-streamfuction ('key_diaeiv') 64 #endif 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk ! T-point basin interior masks 56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: btm30 ! mask out Southern Ocean (=0 south of 30°S) 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: htr , str ! adv heat and salt transports (approx) 58 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_jk, sn_jk , v_msf ! i-mean T and S, j-Stream-Function 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sjk , r1_sjk ! i-mean i-k-surface and its inverse 60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: htr_eiv, str_eiv ! bolus adv heat ans salt transports ('key_diaeiv') 61 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_msf_eiv ! bolus j-streamfuction ('key_diaeiv') 62 65 63 66 64 INTEGER :: niter ! … … 78 76 !! Integer, 1D workspace arrays. Not common enough to be implemented in 79 77 !! wrk_nemo module. 80 INTEGER, ALLOCATABLE, SAVE, DIMENSION 81 INTEGER, ALLOCATABLE, SAVE, DIMENSION 82 INTEGER, ALLOCATABLE, SAVE, DIMENSION 78 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex , ndex_atl , ndex_pac , ndex_ind , ndex_ipc 79 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex_atl_30 , ndex_pac_30 , ndex_ind_30 , ndex_ipc_30 80 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30 83 81 84 82 !! * Substitutions … … 92 90 CONTAINS 93 91 94 92 FUNCTION dia_ptr_alloc() 95 93 !!---------------------------------------------------------------------- 96 94 !! *** ROUTINE dia_ptr_alloc *** 97 95 !!---------------------------------------------------------------------- 98 INTEGER :: dia_ptr_alloc99 INTEGER, DIMENSION(5) :: ierr96 INTEGER :: dia_ptr_alloc ! return value 97 INTEGER, DIMENSION(5) :: ierr 100 98 !!---------------------------------------------------------------------- 101 99 … … 103 101 104 102 ALLOCATE( btmsk(jpi,jpj,nptr) , & 105 htr_adv(jpj) , str_adv(jpj) , &106 htr_ldf(jpj) , str_ldf(jpj) , &107 htr_ove(jpj) , str_ove(jpj), &108 htr(jpj,nptr) , str(jpj,nptr) , &109 tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , &110 sjk (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr(1) )103 & htr_adv(jpj) , str_adv(jpj) , & 104 & htr_ldf(jpj) , str_ldf(jpj) , & 105 & htr_ove(jpj) , str_ove(jpj), & 106 & htr(jpj,nptr) , str(jpj,nptr) , & 107 & tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , & 108 & sjk (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr(1) ) 111 109 ! 112 110 #if defined key_diaeiv 113 111 ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 114 112 & v_msf_eiv(jpj,jpk,nptr) , STAT=ierr(2) ) 115 113 #endif 116 114 … … 118 116 119 117 ALLOCATE(ndex(jpj*jpk), ndex_atl(jpj*jpk), ndex_pac(jpj*jpk), & 120 121 118 & ndex_ind(jpj*jpk), ndex_ipc(jpj*jpk), & 119 & ndex_atl_30(jpj*jpk), ndex_pac_30(jpj*jpk), Stat=ierr(4)) 122 120 123 121 ALLOCATE(ndex_ind_30(jpj*jpk), ndex_ipc_30(jpj*jpk), & 124 ndex_h(jpj), ndex_h_atl_30(jpj), ndex_h_pac_30(jpj), & 125 ndex_h_ind_30(jpj), ndex_h_ipc_30(jpj), Stat=ierr(5)) 126 127 dia_ptr_alloc = MAXVAL(ierr) 128 122 & ndex_h(jpj), ndex_h_atl_30(jpj), ndex_h_pac_30(jpj), & 123 & ndex_h_ind_30(jpj), ndex_h_ipc_30(jpj), Stat=ierr(5) ) 124 ! 125 dia_ptr_alloc = MAXVAL( ierr ) 126 IF(lk_mpp) CALL mpp_sum( dia_ptr_alloc ) 127 ! 129 128 END FUNCTION dia_ptr_alloc 130 129 … … 141 140 !! ** Action : - p_fval: i-k-mean poleward flux of pva 142 141 !!---------------------------------------------------------------------- 143 IMPLICIT none144 142 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 145 143 !! … … 160 158 END DO 161 159 END DO 162 ! 163 #if defined key_mpp_mpi 164 CALL mpp_sum( p_fval, ijpj, ncomm_znl) 160 #if defined key_mpp_mpi 161 IF(lk_mpp) CALL mpp_sum( p_fval, ijpj, ncomm_znl) 165 162 #endif 166 163 ! … … 196 193 END DO 197 194 END DO 198 !199 195 #if defined key_mpp_mpi 200 196 CALL mpp_sum( p_fval, ijpj, ncomm_znl ) … … 234 230 ! 235 231 #if defined key_mpp_mpi 236 IF(.not. wrk_use(1, 1))THEN 237 CALL ctl_stop('ptr_vjk: ERROR - requested workspace array is unavailable') 238 RETURN 232 IF( .not. wrk_use(1, 1) ) THEN 233 CALL ctl_stop('ptr_vjk: ERROR - requested workspace array is unavailable') ; RETURN 239 234 END IF 240 235 #endif … … 272 267 ! 273 268 #if defined key_mpp_mpi 274 IF(.not. wrk_release(1, 1))THEN 275 CALL ctl_stop('ptr_vjk: ERROR - failed to release workspace array') 276 END IF 269 IF(.NOT. wrk_release(1, 1) ) CALL ctl_stop('ptr_vjk: ERROR - failed to release workspace array') 277 270 #endif 278 271 ! … … 333 326 ! 334 327 #if defined key_mpp_mpi 335 IF(.NOT. wrk_release(1, 1))THEN 336 CALL ctl_stop('ptr_tjk: failed to release workspace array.') 337 END IF 328 IF( .NOT. wrk_release(1, 1) ) CALL ctl_stop('ptr_tjk: failed to release workspace array.') 338 329 #endif 339 330 ! … … 461 452 NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nn_fptr, nn_fwri 462 453 !!---------------------------------------------------------------------- 454 455 ! ! allocate dia_ptr arrays 456 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate arrays' ) 463 457 464 458 REWIND( numnam ) ! Read Namelist namptr : poleward transport parameters … … 547 541 !! 548 542 INTEGER, SAVE :: nhoridz, ndepidzt, ndepidzw 549 INTEGER, SAVE :: ndim , ndim_atl , ndim_pac , ndim_ind , ndim_ipc550 INTEGER, SAVE :: ndim_atl_30 , ndim_pac_30 , ndim_ind_30 , ndim_ipc_30551 INTEGER, SAVE :: ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30552 !! 553 CHARACTER (len=40) 554 INTEGER 543 INTEGER, SAVE :: ndim , ndim_atl , ndim_pac , ndim_ind , ndim_ipc 544 INTEGER, SAVE :: ndim_atl_30 , ndim_pac_30 , ndim_ind_30 , ndim_ipc_30 545 INTEGER, SAVE :: ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30 546 !! 547 CHARACTER (len=40) :: clhstnam, clop, clop_once, cl_comment ! temporary names 548 INTEGER :: iline, it, itmod, ji, jj, jk ! 555 549 #if defined key_iomput 556 INTEGER 557 #endif 558 REAL(wp) 550 INTEGER :: inum ! temporary logical unit 551 #endif 552 REAL(wp) :: zsto, zout, zdt, zjulian ! temporary scalars 559 553 !!---------------------------------------------------------------------- 560 554 561 555 IF( (.not. wrk_use(1, 1,2)) .OR. (.not. wrk_use(2, 1)) )THEN 562 CALL ctl_stop('dia_ptr_wri: ERROR: requested workspace arrays unavailable') 563 RETURN 556 CALL ctl_stop('dia_ptr_wri: ERROR: requested workspace arrays unavailable') ; RETURN 564 557 END IF 565 558 … … 641 634 zfoo(1:jpj) = 0._wp 642 635 643 ! Compute julian date from starting date of the run 644 645 CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) 646 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 636 CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) ! Compute julian date from starting date of the run 637 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 647 638 648 639 #if defined key_iomput … … 667 658 CALL histvert( numptr, "depthw", "Vertical W levels", & 668 659 & "m", jpk, gdepw_0, ndepidzw, "down" ) 669 670 660 ! 671 661 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,1), 1._wp), 1, 1., ndex , ndim ) ! Lat-Depth … … 701 691 cl_comment = ' ' 702 692 #endif 703 ! Zonal mean T and S 704 705 IF( ln_diaznl ) THEN 693 IF( ln_diaznl ) THEN ! Zonal mean T and S 706 694 CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" , & 707 695 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) … … 711 699 CALL histdef( numptr, "zosrfglo", "Zonal Mean Surface","m^2" , & 712 700 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 713 701 ! 714 702 IF (ln_subbas) THEN 715 703 CALL histdef( numptr, "zotematl", "Zonal Mean Temperature: Atlantic","C" , & … … 741 729 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 742 730 ENDIF 743 744 731 ENDIF 745 732 ! 746 733 ! Meridional Stream-Function (Eulerian and Bolus) 747 748 734 CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global"//TRIM(cl_comment),"Sv" , & 749 735 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) … … 758 744 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 759 745 ENDIF 760 746 ! 761 747 ! Heat transport 762 763 748 CALL histdef( numptr, "sophtadv", "Advective Heat Transport" , & 764 749 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) … … 779 764 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 780 765 ENDIF 781 782 766 ! 783 767 ! Salt transport 784 785 768 CALL histdef( numptr, "sopstadv", "Advective Salt Transport" , & 786 769 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) … … 810 793 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 811 794 ENDIF 812 795 ! 813 796 CALL histend( numptr ) 814 797 ! 815 798 END IF 816 799 #if defined key_mpp_mpi … … 886 869 ENDIF 887 870 ! 888 IF( (.not. wrk_release(1, 1,2)) .OR. (.not. wrk_release(2, 1)) )THEN 889 CALL ctl_stop('dia_ptr_wri: ERROR: failed to release workspace arrays') 890 END IF 871 IF( .not. wrk_release(1, 1,2) .OR. (.not. wrk_release(2, 1)) ) & 872 CALL ctl_stop('dia_ptr_wri: failed to release workspace arrays') 891 873 ! 892 874 END SUBROUTINE dia_ptr_wri
Note: See TracChangeset
for help on using the changeset viewer.
