Changeset 3148
- Timestamp:
- 2011-11-17T17:28:07+01:00 (12 years ago)
- Location:
- branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 20 edited
-
iceini.F90 (modified) (2 diffs)
-
limadv.F90 (modified) (7 diffs)
-
limdyn.F90 (modified) (4 diffs)
-
limhdf.F90 (modified) (4 diffs)
-
limistate.F90 (modified) (3 diffs)
-
limitd_me.F90 (modified) (15 diffs)
-
limitd_th.F90 (modified) (16 diffs)
-
limrhg.F90 (modified) (5 diffs)
-
limrst.F90 (modified) (7 diffs)
-
limsbc.F90 (modified) (4 diffs)
-
limthd.F90 (modified) (4 diffs)
-
limthd_dh.F90 (modified) (4 diffs)
-
limthd_dif.F90 (modified) (3 diffs)
-
limthd_ent.F90 (modified) (4 diffs)
-
limthd_lac.F90 (modified) (4 diffs)
-
limthd_sal.F90 (modified) (4 diffs)
-
limtrp.F90 (modified) (4 diffs)
-
limupdate.F90 (modified) (9 diffs)
-
limvar.F90 (modified) (6 diffs)
-
limwri.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90
r2715 r3148 23 23 USE thd_ice ! LIM thermodynamical variables 24 24 USE limitd_me ! LIM ice thickness distribution 25 USE limrhg ! LIM dynamics26 25 USE limmsh ! LIM mesh 27 26 USE limistate ! LIM initial state … … 56 55 57 56 ! ! Allocate the ice arrays 58 ierr = ice_alloc () ! ice variables 59 ierr = ierr + dom_ice_alloc () ! domain 60 ierr = ierr + sbc_ice_alloc () ! surface forcing 61 ierr = ierr + thd_ice_alloc () ! thermodynamics 62 ierr = ierr + lim_itd_me_alloc() ! ice thickness distribution - mechanics 63 ierr = ierr + lim_rhg_alloc () ! dynamics 57 ierr = ice_alloc () ! ice variables 58 ierr = ierr + dom_ice_alloc () ! domain 59 ierr = ierr + sbc_ice_alloc () ! surface forcing 60 ierr = ierr + thd_ice_alloc () ! thermodynamics 61 ierr = ierr + lim_itd_me_alloc () ! ice thickness distribution - mechanics 64 62 ! 65 63 IF( lk_mpp ) CALL mpp_sum( ierr ) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90
r2715 r3148 22 22 USE prtctl ! Print control 23 23 USE lib_mpp ! MPP library 24 USE wrk_nemo_2 ! work arrays 24 25 25 26 IMPLICIT NONE … … 56 57 !! Reference: Prather, 1986, JGR, 91, D6. 6671-6681. 57 58 !!-------------------------------------------------------------------- 58 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released59 USE wrk_nemo, ONLY: zf0 => wrk_2d_11 , zfx => wrk_2d_12 , zfy => wrk_2d_13 , zbet => wrk_2d_14 ! 2D workspace60 USE wrk_nemo, ONLY: zfm => wrk_2d_15 , zfxx => wrk_2d_16 , zfyy => wrk_2d_17 , zfxy => wrk_2d_18 ! - -61 USE wrk_nemo, ONLY: zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21 ! - -62 !63 59 REAL(wp) , INTENT(in ) :: pdf ! reduction factor for the time step 64 60 REAL(wp) , INTENT(in ) :: pcrh ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0) … … 73 69 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 74 70 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 71 REAL(wp), POINTER, DIMENSION(:,:) :: zf0 , zfx , zfy , zbet ! 2D workspace 72 REAL(wp), POINTER, DIMENSION(:,:) :: zfm , zfxx , zfyy , zfxy ! - - 73 REAL(wp), POINTER, DIMENSION(:,:) :: zalg, zalg1, zalg1q ! - - 75 74 !--------------------------------------------------------------------- 76 75 77 IF( wrk_in_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 78 CALL ctl_stop('lim_adv_x: requested workspace arrays unavailable') ; RETURN 79 ENDIF 76 CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm ) 77 CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q ) 80 78 81 79 ! Limitation of moments. … … 224 222 ENDIF 225 223 ! 226 IF( wrk_not_released(2, 11,12,13,14,15,16,17,18,19,20,21) ) &227 CALL ctl_stop('lim_adv_x : failed to release workspace arrays')224 CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm ) 225 CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q ) 228 226 ! 229 227 END SUBROUTINE lim_adv_x … … 244 242 !! Reference: Prather, 1986, JGR, 91, D6. 6671-6681. 245 243 !!--------------------------------------------------------------------- 246 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released247 USE wrk_nemo, ONLY: zf0 => wrk_2d_11 , zfx => wrk_2d_12 , zfy => wrk_2d_13 , zbet => wrk_2d_14 ! 2D workspace248 USE wrk_nemo, ONLY: zfm => wrk_2d_15 , zfxx => wrk_2d_16 , zfyy => wrk_2d_17 , zfxy => wrk_2d_18 ! - -249 USE wrk_nemo, ONLY: zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21 ! - -250 !251 244 REAL(wp) , INTENT(in ) :: pdf ! reduction factor for the time step 252 245 REAL(wp) , INTENT(in ) :: pcrh ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0) … … 261 254 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 262 255 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 256 REAL(wp), POINTER, DIMENSION(:,:) :: zf0, zfx , zfy , zbet ! 2D workspace 257 REAL(wp), POINTER, DIMENSION(:,:) :: zfm, zfxx, zfyy, zfxy ! - - 258 REAL(wp), POINTER, DIMENSION(:,:) :: zalg, zalg1, zalg1q ! - - 263 259 !--------------------------------------------------------------------- 264 260 265 IF( wrk_in_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 266 CALL ctl_stop('lim_adv_y : requested workspace arrays unavailable') ; RETURN 267 ENDIF 261 CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm ) 262 CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q ) 268 263 269 264 ! Limitation of moments. … … 413 408 ENDIF 414 409 ! 415 IF( wrk_not_released(2, 11,12,13,14,15,16,17,18,19,20,21) ) &416 CALL ctl_stop('lim_adv_y: failed to release workspace arrays')410 CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm ) 411 CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q ) 417 412 ! 418 413 END SUBROUTINE lim_adv_y -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r2715 r3148 25 25 USE lbclnk ! lateral boundary conditions - MPP exchanges 26 26 USE lib_mpp ! MPP library 27 USE wrk_nemo_2 ! work arrays 27 28 USE in_out_manager ! I/O manager 28 29 USE prtctl ! Print control … … 55 56 !! - treatment of the case if no ice dynamic 56 57 !!------------------------------------------------------------------------------------ 57 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released58 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_259 USE wrk_nemo, ONLY: zu_io => wrk_2d_1, zv_io => wrk_2d_2 ! ice-ocean velocity60 !61 58 INTEGER, INTENT(in) :: kt ! number of iteration 62 59 !! … … 64 61 INTEGER :: i_j1, i_jpj ! Starting/ending j-indices for rheology 65 62 REAL(wp) :: zcoef ! local scalar 66 REAL(wp), POINTER, DIMENSION(:) :: zind ! i-averaged indicator of sea-ice 67 REAL(wp), POINTER, DIMENSION(:) :: zmsk ! i-averaged of tmask 63 REAL(wp), POINTER, DIMENSION(:) :: zind ! i-averaged indicator of sea-ice 64 REAL(wp), POINTER, DIMENSION(:) :: zmsk ! i-averaged of tmask 65 REAL(wp), POINTER, DIMENSION(:,:) :: zu_io, zv_io ! ice-ocean velocity 68 66 !!--------------------------------------------------------------------- 69 67 70 IF( wrk_in_use(1, 1,2) .OR. wrk_in_use(2, 1,2) ) THEN 71 CALL ctl_stop('lim_dyn : requested workspace arrays unavailable') ; RETURN 72 ENDIF 73 zind => wrk_1d_1(1:jpj) ! Set-up pointers to sub-arrays of workspaces 74 zmsk => wrk_1d_2(1:jpj) 68 CALL wrk_alloc( jpi, jpj, zu_io, zv_io ) 69 CALL wrk_alloc( jpj, zind, zmsk ) 75 70 76 71 IF( kt == nit000 ) CALL lim_dyn_init ! Initialization (first time-step only) … … 212 207 ENDIF 213 208 ! 214 IF( wrk_not_released(1, 1,2) .OR. &215 wrk_not_released(2, 1,2) ) CALL ctl_stop('lim_dyn : failed to release workspace arrays')209 CALL wrk_dealloc( jpi, jpj, zu_io, zv_io ) 210 CALL wrk_dealloc( jpj, zind, zmsk ) 216 211 ! 217 212 END SUBROUTINE lim_dyn -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r2715 r3148 18 18 USE lbclnk ! lateral boundary condition - MPP exchanges 19 19 USE lib_mpp ! MPP library 20 USE wrk_nemo_2 ! work arrays 20 21 USE prtctl ! Print control 21 22 USE in_out_manager ! I/O manager … … 50 51 !! ** Action : update ptab with the diffusive contribution 51 52 !!------------------------------------------------------------------- 52 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released53 USE wrk_nemo, ONLY: zflu => wrk_2d_11, zdiv => wrk_2d_13, zrlx => wrk_2d_1554 USE wrk_nemo, ONLY: zflv => wrk_2d_12, zdiv0 => wrk_2d_14, ztab0 => wrk_2d_1655 !56 53 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: ptab ! Field on which the diffusion is applied 57 54 ! … … 59 56 INTEGER :: its, iter, ierr ! local integers 60 57 REAL(wp) :: zalfa, zrlxint, zconv, zeps ! local scalars 58 REAL(wp), POINTER, DIMENSION(:,:) :: zrlx, zflu, zflv, zdiv0, zdiv, ztab0 61 59 CHARACTER(lc) :: charout ! local character 62 60 !!------------------------------------------------------------------- 63 61 64 IF( wrk_in_use(2, 11,12,13,14,15,16) ) THEN 65 CALL ctl_stop( 'lim_hdf: requested workspace arrays unavailable' ) ; RETURN 66 ENDIF 62 CALL wrk_alloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 ) 67 63 68 64 ! !== Initialisation ==! … … 146 142 ENDIF 147 143 ! 148 IF( wrk_not_released(2, 11,12,13,14,15,16) ) CALL ctl_stop('lim_hdf: failed to release workspace arrays')144 CALL wrk_dealloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 ) 149 145 ! 150 146 END SUBROUTINE lim_hdf -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r2977 r3148 25 25 USE lbclnk ! lateral boundary condition - MPP exchanges 26 26 USE lib_mpp ! MPP library 27 USE wrk_nemo_2 ! work arrays 27 28 28 29 IMPLICIT NONE … … 62 63 !! or from arbitrary sea-ice conditions 63 64 !!------------------------------------------------------------------- 64 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released65 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2, wrk_1d_3, wrk_1d_466 USE wrk_nemo, ONLY: zidto => wrk_2d_1 ! ice indicator67 !68 65 INTEGER :: ji, jj, jk, jl ! dummy loop indices 69 66 REAL(wp) :: zeps6, zeps, ztmelts, epsi06 ! local scalars 70 67 REAL(wp) :: zvol, zare, zh, zh1, zh2, zh3, zan, zbn, zas, zbs 71 REAL(wp), POINTER, DIMENSION(:) :: zgfactorn, zhin 72 REAL(wp), POINTER, DIMENSION(:) :: zgfactors, zhis 73 !-------------------------------------------------------------------- 74 75 IF( wrk_in_use(2, 1) .OR. wrk_in_use(1, 1,2,3,4) ) THEN 76 CALL ctl_stop( 'lim_istate: requested workspace arrays unavailable' ) ; RETURN 77 ENDIF 78 zgfactorn => wrk_1d_1(1:jpm) ; zhin => wrk_1d_3(1:jpm) ! Set-up pointers to sub-arrays of workspaces 79 zgfactors => wrk_1d_2(1:jpm) ; zhis => wrk_1d_4(1:jpm) 68 REAL(wp), POINTER, DIMENSION(:) :: zgfactorn, zhin 69 REAL(wp), POINTER, DIMENSION(:) :: zgfactors, zhis 70 REAL(wp), POINTER, DIMENSION(:,:) :: zidto ! ice indicator 71 !-------------------------------------------------------------------- 72 73 CALL wrk_alloc( jpm, zgfactorn, zgfactors, zhin, zhis ) 74 CALL wrk_alloc( jpi, jpj, zidto ) 80 75 81 76 !-------------------------------------------------------------------- … … 517 512 CALL lbc_lnk( fsbbq , 'T', 1. ) 518 513 ! 519 IF( wrk_not_released(2, 1) .OR. wrk_not_released(1, 1,2,3,4) ) &520 & CALL ctl_stop('lim_istate : failed to release workspace arrays')514 CALL wrk_dealloc( jpm, zgfactorn, zgfactors, zhin, zhis ) 515 CALL wrk_dealloc( jpi, jpj, zidto ) 521 516 ! 522 517 END SUBROUTINE lim_istate -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r2777 r3148 26 26 USE lbclnk ! lateral boundary condition - MPP exchanges 27 27 USE lib_mpp ! MPP library 28 USE wrk_nemo_2 ! work arrays 28 29 USE prtctl ! Print control 29 USE wrk_nemo ! workspace manager30 30 31 31 IMPLICIT NONE … … 36 36 PUBLIC lim_itd_me_init 37 37 PUBLIC lim_itd_me_zapsmall 38 PUBLIC lim_itd_me_alloc ! called by nemogcm.F9038 PUBLIC lim_itd_me_alloc ! called by iceini.F90 39 39 40 40 REAL(wp) :: epsi11 = 1.e-11_wp ! constant values … … 70 70 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: dvirdgdt ! rate of ice volume ridged (m/s) 71 71 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: opening ! rate of opening due to divergence/shear (1/s) 72 73 72 !!---------------------------------------------------------------------- 74 73 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010) … … 125 124 !! and Elizabeth C. Hunke, LANL are gratefully acknowledged 126 125 !!--------------------------------------------------------------------! 127 USE wrk_nemo, ONLY: closing_net => wrk_2d_1 ! net rate at which area is removed (1/s)128 ! ! (ridging ice area - area of new ridges) / dt129 USE wrk_nemo, ONLY: divu_adv => wrk_2d_2 ! divu as implied by transport scheme (1/s)130 USE wrk_nemo, ONLY: opning => wrk_2d_3 ! rate of opening due to divergence/shear131 USE wrk_nemo, ONLY: closing_gross => wrk_2d_4 ! rate at which area removed, not counting area of new ridges132 USE wrk_nemo, ONLY: msnow_mlt => wrk_2d_5 ! mass of snow added to ocean (kg m-2)133 USE wrk_nemo, ONLY: esnow_mlt => wrk_2d_6 ! energy needed to melt snow in ocean (J m-2)134 USE wrk_nemo, ONLY: vt_i_init => wrk_2d_7 ! ice volume summed over135 USE wrk_nemo, ONLY: vt_i_final => wrk_2d_8 ! categories136 !137 126 INTEGER :: ji, jj, jk, jl ! dummy loop index 138 127 INTEGER :: niter, nitermax = 20 ! local integer … … 141 130 REAL(wp) :: w1, tmpfac, dti ! local scalar 142 131 CHARACTER (len = 15) :: fieldid 132 REAL(wp), POINTER, DIMENSION(:,:) :: closing_net ! net rate at which area is removed (1/s) 133 ! (ridging ice area - area of new ridges) / dt 134 REAL(wp), POINTER, DIMENSION(:,:) :: divu_adv ! divu as implied by transport scheme (1/s) 135 REAL(wp), POINTER, DIMENSION(:,:) :: opning ! rate of opening due to divergence/shear 136 REAL(wp), POINTER, DIMENSION(:,:) :: closing_gross ! rate at which area removed, not counting area of new ridges 137 REAL(wp), POINTER, DIMENSION(:,:) :: msnow_mlt ! mass of snow added to ocean (kg m-2) 138 REAL(wp), POINTER, DIMENSION(:,:) :: esnow_mlt ! energy needed to melt snow in ocean (J m-2) 139 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories 143 140 !!----------------------------------------------------------------------------- 144 141 145 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8) ) THEN 146 CALL ctl_stop('lim_itd_me: requested workspace arrays unavailable') ; RETURN 147 ENDIF 142 CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 148 143 149 144 IF( numit == nstart ) CALL lim_itd_me_init ! Initialization (first time-step only) … … 489 484 END DO 490 485 491 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8) ) CALL ctl_stop('lim_itd_me: failed to release workspace arrays')486 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 492 487 ! 493 488 END SUBROUTINE lim_itd_me … … 508 503 !! ** Inputs / Ouputs : kstrngth (what kind of ice strength we are using) 509 504 !!---------------------------------------------------------------------- 510 USE wrk_nemo, ONLY: zworka => wrk_2d_3 ! 2D workspace511 !512 505 INTEGER, INTENT(in) :: kstrngth ! = 1 for Rothrock formulation, 0 for Hibler (1979) 513 506 … … 515 508 INTEGER :: ksmooth ! smoothing the resistance to deformation 516 509 INTEGER :: numts_rm ! number of time steps for the P smoothing 517 518 510 REAL(wp) :: hi, zw1, zp, zdummy, zzc, z1_3 ! local scalars 511 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here 519 512 !!---------------------------------------------------------------------- 520 513 521 IF( wrk_in_use(2, 3) ) THEN 522 CALL ctl_stop('lim_itd_me_icestrength : requested workspace array unavailable') ; RETURN 523 ENDIF 514 CALL wrk_alloc( jpi, jpj, zworka ) 524 515 525 516 !------------------------------------------------------------------------------! … … 675 666 CALL lbc_lnk( strength, 'T', 1. ) ! Boundary conditions 676 667 677 IF( wrk_not_released(2, 3) ) CALL ctl_stop('lim_itd_me_icestrength: failed to release workspace array')668 CALL wrk_dealloc( jpi, jpj, zworka ) 678 669 ! 679 670 END SUBROUTINE lim_itd_me_icestrength … … 691 682 INTEGER :: ji,jj, jl ! dummy loop indices 692 683 INTEGER :: krdg_index ! 693 694 684 REAL(wp) :: Gstari, astari, hi, hrmean, zdummy ! local scalar 695 696 REAL(wp), DIMENSION(jpi,jpj,-1:jpl) :: Gsum ! Gsum(n) = sum of areas in categories 0 to n 697 698 REAL(wp), DIMENSION(jpi,jpj) :: zworka ! temporary array used here 685 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here 686 REAL(wp), POINTER, DIMENSION(:,:,:) :: Gsum ! Gsum(n) = sum of areas in categories 0 to n 699 687 !------------------------------------------------------------------------------! 688 689 CALL wrk_alloc( jpi,jpj, zworka ) 690 CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 700 691 701 692 Gstari = 1.0/Gstar … … 900 891 END DO 901 892 ! 893 CALL wrk_dealloc( jpi,jpj, zworka ) 894 CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 895 ! 902 896 END SUBROUTINE lim_itd_me_ridgeprep 903 897 … … 929 923 REAL(wp) :: hL, hR, farea, zdummy, zdummy0, ztmelts ! left and right limits of integration 930 924 931 INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: indxi, indxj ! compressed indices 932 933 REAL(wp), DIMENSION(jpi,jpj) :: vice_init, vice_final ! ice volume summed over categories 934 REAL(wp), DIMENSION(jpi,jpj) :: eice_init, eice_final ! ice energy summed over layers 935 936 REAL(wp), DIMENSION(jpi,jpj,jpl) :: aicen_init, vicen_init ! ice area & volume before ridging 937 REAL(wp), DIMENSION(jpi,jpj,jpl) :: vsnon_init, esnon_init ! snow volume & energy before ridging 938 REAL(wp), DIMENSION(jpi,jpj,jpl) :: smv_i_init, oa_i_init ! ice salinity & age before ridging 939 940 REAL(wp), DIMENSION(jpi,jpj,jkmax,jpl) :: eicen_init ! ice energy before ridging 941 942 REAL(wp), DIMENSION(jpi,jpj) :: afrac , fvol ! fraction of category area ridged & new ridge volume going to n2 943 REAL(wp), DIMENSION(jpi,jpj) :: ardg1 , ardg2 ! area of ice ridged & new ridges 944 REAL(wp), DIMENSION(jpi,jpj) :: vsrdg , esrdg ! snow volume & energy of ridging ice 945 REAL(wp), DIMENSION(jpi,jpj) :: oirdg1, oirdg2 ! areal age content of ridged & rifging ice 946 REAL(wp), DIMENSION(jpi,jpj) :: dhr , dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2 947 948 REAL(wp), DIMENSION(jpi,jpj) :: vrdg1 ! volume of ice ridged 949 REAL(wp), DIMENSION(jpi,jpj) :: vrdg2 ! volume of new ridges 950 REAL(wp), DIMENSION(jpi,jpj) :: vsw ! volume of seawater trapped into ridges 951 REAL(wp), DIMENSION(jpi,jpj) :: srdg1 ! sal*volume of ice ridged 952 REAL(wp), DIMENSION(jpi,jpj) :: srdg2 ! sal*volume of new ridges 953 REAL(wp), DIMENSION(jpi,jpj) :: smsw ! sal*volume of water trapped into ridges 954 955 REAL(wp), DIMENSION(jpi,jpj) :: afrft ! fraction of category area rafted 956 REAL(wp), DIMENSION(jpi,jpj) :: arft1 , arft2 ! area of ice rafted and new rafted zone 957 REAL(wp), DIMENSION(jpi,jpj) :: virft , vsrft ! ice & snow volume of rafting ice 958 REAL(wp), DIMENSION(jpi,jpj) :: esrft , smrft ! snow energy & salinity of rafting ice 959 REAL(wp), DIMENSION(jpi,jpj) :: oirft1, oirft2 ! areal age content of rafted ice & rafting ice 960 961 REAL(wp), DIMENSION(jpi,jpj,jkmax) :: eirft ! ice energy of rafting ice 962 REAL(wp), DIMENSION(jpi,jpj,jkmax) :: erdg1 ! enth*volume of ice ridged 963 REAL(wp), DIMENSION(jpi,jpj,jkmax) :: erdg2 ! enth*volume of new ridges 964 REAL(wp), DIMENSION(jpi,jpj,jkmax) :: ersw ! enth of water trapped into ridges 965 !!---------------------------------------------------------------------- 925 INTEGER , POINTER, DIMENSION(:) :: indxi, indxj ! compressed indices 926 927 REAL(wp), POINTER, DIMENSION(:,:) :: vice_init, vice_final ! ice volume summed over categories 928 REAL(wp), POINTER, DIMENSION(:,:) :: eice_init, eice_final ! ice energy summed over layers 929 930 REAL(wp), POINTER, DIMENSION(:,:,:) :: aicen_init, vicen_init ! ice area & volume before ridging 931 REAL(wp), POINTER, DIMENSION(:,:,:) :: vsnon_init, esnon_init ! snow volume & energy before ridging 932 REAL(wp), POINTER, DIMENSION(:,:,:) :: smv_i_init, oa_i_init ! ice salinity & age before ridging 933 934 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: eicen_init ! ice energy before ridging 935 936 REAL(wp), POINTER, DIMENSION(:,:) :: afrac , fvol ! fraction of category area ridged & new ridge volume going to n2 937 REAL(wp), POINTER, DIMENSION(:,:) :: ardg1 , ardg2 ! area of ice ridged & new ridges 938 REAL(wp), POINTER, DIMENSION(:,:) :: vsrdg , esrdg ! snow volume & energy of ridging ice 939 REAL(wp), POINTER, DIMENSION(:,:) :: oirdg1, oirdg2 ! areal age content of ridged & rifging ice 940 REAL(wp), POINTER, DIMENSION(:,:) :: dhr , dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2 941 942 REAL(wp), POINTER, DIMENSION(:,:) :: vrdg1 ! volume of ice ridged 943 REAL(wp), POINTER, DIMENSION(:,:) :: vrdg2 ! volume of new ridges 944 REAL(wp), POINTER, DIMENSION(:,:) :: vsw ! volume of seawater trapped into ridges 945 REAL(wp), POINTER, DIMENSION(:,:) :: srdg1 ! sal*volume of ice ridged 946 REAL(wp), POINTER, DIMENSION(:,:) :: srdg2 ! sal*volume of new ridges 947 REAL(wp), POINTER, DIMENSION(:,:) :: smsw ! sal*volume of water trapped into ridges 948 949 REAL(wp), POINTER, DIMENSION(:,:) :: afrft ! fraction of category area rafted 950 REAL(wp), POINTER, DIMENSION(:,:) :: arft1 , arft2 ! area of ice rafted and new rafted zone 951 REAL(wp), POINTER, DIMENSION(:,:) :: virft , vsrft ! ice & snow volume of rafting ice 952 REAL(wp), POINTER, DIMENSION(:,:) :: esrft , smrft ! snow energy & salinity of rafting ice 953 REAL(wp), POINTER, DIMENSION(:,:) :: oirft1, oirft2 ! areal age content of rafted ice & rafting ice 954 955 REAL(wp), POINTER, DIMENSION(:,:,:) :: eirft ! ice energy of rafting ice 956 REAL(wp), POINTER, DIMENSION(:,:,:) :: erdg1 ! enth*volume of ice ridged 957 REAL(wp), POINTER, DIMENSION(:,:,:) :: erdg2 ! enth*volume of new ridges 958 REAL(wp), POINTER, DIMENSION(:,:,:) :: ersw ! enth of water trapped into ridges 959 !!---------------------------------------------------------------------- 960 961 CALL wrk_alloc( (jpi+1)*(jpj+1), indxi, indxj ) 962 CALL wrk_alloc( jpi, jpj, vice_init, vice_final, eice_init, eice_final ) 963 CALL wrk_alloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 ) 964 CALL wrk_alloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw ) 965 CALL wrk_alloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 966 CALL wrk_alloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnon_init, esnon_init, smv_i_init, oa_i_init ) 967 CALL wrk_alloc( jpi, jpj, jkmax, eirft, erdg1, erdg2, ersw ) 968 CALL wrk_alloc( jpi, jpj, jkmax, jpl, eicen_init ) 966 969 967 970 ! Conservation check … … 1358 1361 WRITE(numout,*) ' eice_final : ', eice_final(jiindx,jjindx) 1359 1362 ENDIF 1363 ! 1364 CALL wrk_dealloc( (jpi+1)*(jpj+1), indxi, indxj ) 1365 CALL wrk_dealloc( jpi, jpj, vice_init, vice_final, eice_init, eice_final ) 1366 CALL wrk_dealloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 ) 1367 CALL wrk_dealloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw ) 1368 CALL wrk_dealloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 1369 CALL wrk_dealloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnon_init, esnon_init, smv_i_init, oa_i_init ) 1370 CALL wrk_dealloc( jpi, jpj, jkmax, eirft, erdg1, erdg2, ersw ) 1371 CALL wrk_dealloc( jpi, jpj, jkmax, jpl, eicen_init ) 1360 1372 ! 1361 1373 END SUBROUTINE lim_itd_me_ridgeshift … … 1448 1460 INTEGER :: icells ! number of cells with ice to zap 1449 1461 1450 REAL(wp), DIMENSION(jpi,jpj) :: zmask ! 2D workspace1462 REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! 2D workspace 1451 1463 1452 1464 !!gm REAL(wp) :: xtmp ! temporary variable 1453 1465 !!------------------------------------------------------------------- 1466 1467 CALL wrk_alloc( jpi, jpj, zmask ) 1454 1468 1455 1469 DO jl = 1, jpl … … 1546 1560 ! 1547 1561 END DO ! jl 1562 ! 1563 CALL wrk_dealloc( jpi, jpj, zmask ) 1548 1564 ! 1549 1565 END SUBROUTINE lim_itd_me_zapsmall -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r2715 r3148 33 33 USE in_out_manager ! I/O manager 34 34 USE lib_mpp ! MPP library 35 USE wrk_nemo_2 ! work arrays 35 36 36 37 IMPLICIT NONE 37 38 PRIVATE 38 39 39 PUBLIC lim_itd_th ! called by ice_stp40 PUBLIC lim_itd_th ! called by ice_stp 40 41 PUBLIC lim_itd_th_rem 41 42 PUBLIC lim_itd_th_reb … … 176 177 CHARACTER (len = 15) :: fieldid 177 178 178 INTEGER , DIMENSION(jpi,jpj,jpl-1) :: zdonor ! donor category index 179 180 REAL(wp), DIMENSION(jpi,jpj,jpl) :: & 181 zdhice , & ! ice thickness increment 182 g0 , & ! coefficients for fitting the line of the ITD 183 g1 , & ! coefficients for fitting the line of the ITD 184 hL , & ! left boundary for the ITD for each thickness 185 hR , & ! left boundary for the ITD for each thickness 186 zht_i_o , & ! old ice thickness 187 dummy_es 188 189 REAL(wp), DIMENSION(jpi,jpj,jpl-1) :: zdaice, zdvice ! local increment of ice area and volume 190 191 REAL(wp), DIMENSION(jpi,jpj,0:jpl) :: zhbnew ! new boundaries of ice categories 192 193 194 REAL, DIMENSION(1:(jpi+1)*(jpj+1)) :: zvetamin, zvetamax ! maximum values for etas 195 196 INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: nind_i, nind_j ! compressed indices for i/j directions 197 198 INTEGER :: nbrem ! number of cells with ice to transfer 199 200 LOGICAL, DIMENSION(jpi,jpj) :: zremap_flag ! compute remapping or not ???? 201 202 REAL(wp) :: zslope ! used to compute local thermodynamic "speeds" 203 204 REAL(wp), DIMENSION(jpi,jpj) :: zhb0, zhb1 ! category boundaries for thinnes categories 205 REAL(wp), DIMENSION(jpi,jpj) :: vt_i_init, vt_i_final ! ice volume summed over categories 206 REAL(wp), DIMENSION(jpi,jpj) :: vt_s_init, vt_s_final ! snow volume summed over categories 207 REAL(wp), DIMENSION(jpi,jpj) :: et_i_init, et_i_final ! ice energy summed over categories 208 REAL(wp), DIMENSION(jpi,jpj) :: et_s_init, et_s_final ! snow energy summed over categories 209 !!------------------------------------------------------------------ 179 INTEGER , POINTER, DIMENSION(:,:,:) :: zdonor ! donor category index 180 181 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdhice ! ice thickness increment 182 REAL(wp), POINTER, DIMENSION(:,:,:) :: g0 ! coefficients for fitting the line of the ITD 183 REAL(wp), POINTER, DIMENSION(:,:,:) :: g1 ! coefficients for fitting the line of the ITD 184 REAL(wp), POINTER, DIMENSION(:,:,:) :: hL ! left boundary for the ITD for each thickness 185 REAL(wp), POINTER, DIMENSION(:,:,:) :: hR ! left boundary for the ITD for each thickness 186 REAL(wp), POINTER, DIMENSION(:,:,:) :: zht_i_o ! old ice thickness 187 REAL(wp), POINTER, DIMENSION(:,:,:) :: dummy_es 188 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdaice, zdvice ! local increment of ice area and volume 189 REAL(wp), POINTER, DIMENSION(:) :: zvetamin, zvetamax ! maximum values for etas 190 INTEGER , POINTER, DIMENSION(:) :: nind_i, nind_j ! compressed indices for i/j directions 191 INTEGER :: nbrem ! number of cells with ice to transfer 192 REAL(wp) :: zslope ! used to compute local thermodynamic "speeds" 193 REAL(wp), POINTER, DIMENSION(:,:) :: zhb0, zhb1 ! category boundaries for thinnes categories 194 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories 195 REAL(wp), POINTER, DIMENSION(:,:) :: vt_s_init, vt_s_final ! snow volume summed over categories 196 REAL(wp), POINTER, DIMENSION(:,:) :: et_i_init, et_i_final ! ice energy summed over categories 197 REAL(wp), POINTER, DIMENSION(:,:) :: et_s_init, et_s_final ! snow energy summed over categories 198 INTEGER , POINTER, DIMENSION(:,:) :: zremap_flag ! compute remapping or not ???? 199 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhbnew ! new boundaries of ice categories 200 !!------------------------------------------------------------------ 201 202 CALL wrk_alloc( jpi,jpj, zremap_flag ) ! integer 203 CALL wrk_alloc( jpi,jpj,jpl-1, zdonor ) ! integer 204 CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_o, dummy_es ) 205 CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice ) 206 CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 ) 207 CALL wrk_alloc( (jpi+1)*(jpj+1), zvetamin, zvetamax ) 208 CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) ! integer 209 CALL wrk_alloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final ) 210 210 211 211 zhimin = 0.1 !minimum ice thickness tolerated by the model … … 266 266 nind_i(nbrem) = ji 267 267 nind_j(nbrem) = jj 268 zremap_flag(ji,jj) = .true.268 zremap_flag(ji,jj) = 1 269 269 ELSE 270 zremap_flag(ji,jj) = .false.270 zremap_flag(ji,jj) = 0 271 271 ENDIF 272 272 END DO !ji … … 312 312 ( ht_i(zji,zjj,jl).GE. zhbnew(zji,zjj,jl) ) & 313 313 ) THEN 314 zremap_flag(zji,zjj) = .false.314 zremap_flag(zji,zjj) = 0 315 315 ELSEIF ( ( a_i(zji,zjj,jl+1) .GT. epsi10 ) .AND. & 316 316 ( ht_i(zji,zjj,jl+1).LE. zhbnew(zji,zjj,jl) ) & 317 317 ) THEN 318 zremap_flag(zji,zjj) = .false.318 zremap_flag(zji,zjj) = 0 319 319 ENDIF 320 320 … … 322 322 ! jl, ji 323 323 IF (zhbnew(zji,zjj,jl).gt.hi_max(jl+1)) THEN 324 zremap_flag(zji,zjj) = .false.324 zremap_flag(zji,zjj) = 0 325 325 ENDIF 326 326 ! jl, ji 327 327 IF (zhbnew(zji,zjj,jl).lt.hi_max(jl-1)) THEN 328 zremap_flag(zji,zjj) = .false.328 zremap_flag(zji,zjj) = 0 329 329 ENDIF 330 330 ! jl, ji … … 339 339 DO jj = 1, jpj 340 340 DO ji = 1, jpi 341 IF ( zremap_flag(ji,jj) ) THEN341 IF ( zremap_flag(ji,jj) == 1 ) THEN 342 342 nbrem = nbrem + 1 343 343 nind_i(nbrem) = ji … … 525 525 ENDIF 526 526 527 CALL wrk_dealloc( jpi,jpj, zremap_flag ) ! integer 528 CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor ) ! integer 529 CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_o, dummy_es ) 530 CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice ) 531 CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 ) 532 CALL wrk_dealloc( (jpi+1)*(jpj+1), zvetamin, zvetamax ) 533 CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) ! integer 534 CALL wrk_dealloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final ) 535 527 536 END SUBROUTINE lim_itd_th_rem 528 537 … … 546 555 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: hL ! min value of range over which g(h) > 0 547 556 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: hR ! max value of range over which g(h) > 0 548 LOGICAL, DIMENSION(jpi,jpj), INTENT(in ) :: zremap_flag !557 INTEGER , DIMENSION(jpi,jpj), INTENT(in ) :: zremap_flag ! 549 558 ! 550 559 INTEGER :: ji,jj ! horizontal indices … … 561 570 DO ji = 1, jpi 562 571 ! 563 IF( zremap_flag(ji,jj) .AND. a_i(ji,jj,num_cat) > zacrith &564 & .AND. hice(ji,jj) > 0._wp ) THEN572 IF( zremap_flag(ji,jj) == 1 .AND. a_i(ji,jj,num_cat) > zacrith & 573 & .AND. hice(ji,jj) > 0._wp ) THEN 565 574 566 575 ! Initialize hL and hR … … 608 617 !! ** Method : 609 618 !!------------------------------------------------------------------ 610 INTEGER , INTENT(in ) :: klbnd ! Start thickness category index point 611 INTEGER , INTENT(in ) :: kubnd ! End point on which the the computation is applied 612 619 INTEGER , INTENT(in ) :: klbnd ! Start thickness category index point 620 INTEGER , INTENT(in ) :: kubnd ! End point on which the the computation is applied 613 621 INTEGER , DIMENSION(jpi,jpj,jpl-1), INTENT(in ) :: zdonor ! donor category index 614 615 622 REAL(wp), DIMENSION(jpi,jpj,jpl-1), INTENT(inout) :: zdaice ! ice area transferred across boundary 616 623 REAL(wp), DIMENSION(jpi,jpj,jpl-1), INTENT(inout) :: zdvice ! ice volume transferred across boundary … … 619 626 INTEGER :: zji, zjj ! indices when changing from 2D-1D is done 620 627 621 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zaTsfn 622 623 REAL(wp), DIMENSION(jpi,jpj) :: zworka ! temporary array used here 628 REAL(wp), POINTER, DIMENSION(:,:,:) :: zaTsfn 629 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here 624 630 625 631 REAL(wp) :: zdvsnow, zdesnow ! snow volume and energy transferred … … 631 637 REAL(wp) :: zindb ! ice or not 632 638 633 INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: nind_i, nind_j ! compressed indices for i/j directions639 INTEGER, POINTER, DIMENSION(:) :: nind_i, nind_j ! compressed indices for i/j directions 634 640 635 641 INTEGER :: nbrem ! number of cells with ice to transfer … … 640 646 LOGICAL :: zdvice_greater_vicen ! true if dvice > vicen 641 647 !!------------------------------------------------------------------ 648 649 CALL wrk_alloc( jpi,jpj,jpl, zaTsfn ) 650 CALL wrk_alloc( jpi,jpj, zworka ) 651 CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) ! integer 642 652 643 653 !---------------------------------------------------------------------------------------------- … … 858 868 END DO ! jl 859 869 ! 870 CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn ) 871 CALL wrk_dealloc( jpi,jpj, zworka ) 872 CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) ! integer 873 ! 860 874 END SUBROUTINE lim_itd_shiftice 861 875 … … 877 891 CHARACTER (len = 15) :: fieldid 878 892 879 INTEGER , DIMENSION(jpi,jpj,jpl) :: zdonor ! donor category index 880 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zdaice, zdvice ! ice area and volume transferred 881 882 REAL (wp), DIMENSION(jpi,jpj) :: vt_i_init, vt_i_final ! ice volume summed over categories 883 REAL (wp), DIMENSION(jpi,jpj) :: vt_s_init, vt_s_final ! snow volume summed over categories 884 !!------------------------------------------------------------------ 893 INTEGER , POINTER, DIMENSION(:,:,:) :: zdonor ! donor category index 894 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdaice, zdvice ! ice area and volume transferred 895 896 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories 897 REAL(wp), POINTER, DIMENSION(:,:) :: vt_s_init, vt_s_final ! snow volume summed over categories 898 !!------------------------------------------------------------------ 899 900 CALL wrk_alloc( jpi,jpj,jpl, zdonor ) ! interger 901 CALL wrk_alloc( jpi,jpj,jpl, zdaice, zdvice ) 902 CALL wrk_alloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final ) 885 903 ! 886 904 IF( con_i ) THEN ! conservation check … … 1015 1033 ENDIF 1016 1034 ! 1035 CALL wrk_dealloc( jpi,jpj,jpl, zdonor ) ! interger 1036 CALL wrk_dealloc( jpi,jpj,jpl, zdaice, zdvice ) 1037 CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final ) 1038 1017 1039 END SUBROUTINE lim_itd_th_reb 1018 1040 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r2717 r3148 24 24 USE lbclnk ! Lateral Boundary Condition / MPP link 25 25 USE lib_mpp ! MPP library 26 USE wrk_nemo_2 ! work arrays 26 27 USE in_out_manager ! I/O manager 27 28 USE prtctl ! Print control … … 39 40 40 41 PUBLIC lim_rhg ! routine called by lim_dyn (or lim_dyn_2) 41 PUBLIC lim_rhg_alloc ! routine called by nemo_alloc in nemogcm.F9042 42 43 43 REAL(wp) :: rzero = 0._wp ! constant values 44 44 REAL(wp) :: rone = 1._wp ! constant values 45 45 46 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zpresh ! temporary array for ice strength47 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zpreshc ! Ice strength on grid cell corners (zpreshc)48 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfrld1, zfrld2 ! lead fraction on U/V points49 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zmass1, zmass2 ! ice/snow mass on U/V points50 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zcorl1, zcorl2 ! coriolis parameter on U/V points51 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: za1ct , za2ct ! temporary arrays52 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zc1 ! ice mass53 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zusw ! temporary weight for ice strength computation54 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce1, v_oce1 ! ocean u/v component on U points55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce2, v_oce2 ! ocean u/v component on V points56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice2, v_ice1 ! ice u/v component on V/U point57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zf1 , zf2 ! arrays for internal stresses58 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zdd , zdt ! Divergence and tension at centre of grid cells60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zds ! Shear on northeast corner of grid cells61 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: deltat, deltac ! Delta at centre and corners of grid cells62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zs1 , zs2 ! Diagonal stress tensor components zs1 and zs263 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zs12 ! Non-diagonal stress tensor component zs1264 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! Local error on velocity65 66 46 !! * Substitutions 67 47 # include "vectopt_loop_substitute.h90" … … 72 52 !!---------------------------------------------------------------------- 73 53 CONTAINS 74 75 FUNCTION lim_rhg_alloc()76 !!-------------------------------------------------------------------77 !! *** FUNCTION lim_rhg_alloc ***78 !!-------------------------------------------------------------------79 INTEGER :: lim_rhg_alloc ! return value80 INTEGER :: ierr(2) ! local integer81 !!-------------------------------------------------------------------82 !83 ierr(:) = 084 !85 ALLOCATE( zpresh (jpi,jpj) , zfrld1(jpi,jpj), zmass1(jpi,jpj), zcorl1(jpi,jpj), za1ct(jpi,jpj) , &86 & zpreshc(jpi,jpj) , zfrld2(jpi,jpj), zmass2(jpi,jpj), zcorl2(jpi,jpj), za2ct(jpi,jpj) , &87 & zc1 (jpi,jpj) , u_oce1(jpi,jpj), u_oce2(jpi,jpj), u_ice2(jpi,jpj), &88 & zusw (jpi,jpj) , v_oce1(jpi,jpj), v_oce2(jpi,jpj), v_ice1(jpi,jpj) , STAT=ierr(1) )89 !90 ALLOCATE( zf1(jpi,jpj) , deltat(jpi,jpj) , zu_ice(jpi,jpj) , &91 & zf2(jpi,jpj) , deltac(jpi,jpj) , zv_ice(jpi,jpj) , &92 & zdd(jpi,jpj) , zdt (jpi,jpj) , zds (jpi,jpj) , &93 & zs1(jpi,jpj) , zs2 (jpi,jpj) , zs12 (jpi,jpj) , zresr(jpi,jpj), STAT=ierr(2) )94 !95 lim_rhg_alloc = MAXVAL(ierr)96 !97 END FUNCTION lim_rhg_alloc98 99 54 100 55 SUBROUTINE lim_rhg( k_j1, k_jpj ) … … 169 124 REAL(wp) :: zindb ! ice (1) or not (0) 170 125 REAL(wp) :: zdummy ! dummy argument 126 127 REAL(wp), POINTER, DIMENSION(:,:) :: zpresh ! temporary array for ice strength 128 REAL(wp), POINTER, DIMENSION(:,:) :: zpreshc ! Ice strength on grid cell corners (zpreshc) 129 REAL(wp), POINTER, DIMENSION(:,:) :: zfrld1, zfrld2 ! lead fraction on U/V points 130 REAL(wp), POINTER, DIMENSION(:,:) :: zmass1, zmass2 ! ice/snow mass on U/V points 131 REAL(wp), POINTER, DIMENSION(:,:) :: zcorl1, zcorl2 ! coriolis parameter on U/V points 132 REAL(wp), POINTER, DIMENSION(:,:) :: za1ct , za2ct ! temporary arrays 133 REAL(wp), POINTER, DIMENSION(:,:) :: zc1 ! ice mass 134 REAL(wp), POINTER, DIMENSION(:,:) :: zusw ! temporary weight for ice strength computation 135 REAL(wp), POINTER, DIMENSION(:,:) :: u_oce1, v_oce1 ! ocean u/v component on U points 136 REAL(wp), POINTER, DIMENSION(:,:) :: u_oce2, v_oce2 ! ocean u/v component on V points 137 REAL(wp), POINTER, DIMENSION(:,:) :: u_ice2, v_ice1 ! ice u/v component on V/U point 138 REAL(wp), POINTER, DIMENSION(:,:) :: zf1 , zf2 ! arrays for internal stresses 139 140 REAL(wp), POINTER, DIMENSION(:,:) :: zdd , zdt ! Divergence and tension at centre of grid cells 141 REAL(wp), POINTER, DIMENSION(:,:) :: zds ! Shear on northeast corner of grid cells 142 REAL(wp), POINTER, DIMENSION(:,:) :: deltat, deltac ! Delta at centre and corners of grid cells 143 REAL(wp), POINTER, DIMENSION(:,:) :: zs1 , zs2 ! Diagonal stress tensor components zs1 and zs2 144 REAL(wp), POINTER, DIMENSION(:,:) :: zs12 ! Non-diagonal stress tensor component zs12 145 REAL(wp), POINTER, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! Local error on velocity 146 171 147 !!------------------------------------------------------------------- 148 149 CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 150 CALL wrk_alloc( jpi,jpj, zc1 , u_oce1, u_oce2, u_ice2, zusw , v_oce1 , v_oce2, v_ice1 ) 151 CALL wrk_alloc( jpi,jpj, zf1 , deltat, zu_ice, zf2 , deltac, zv_ice , zdd , zdt , zds ) 152 CALL wrk_alloc( jpi,jpj, zdd , zdt , zds , zs1 , zs2 , zs12 , zresr ) 153 172 154 #if defined key_lim2 && ! defined key_lim2_vp 173 155 # if defined key_agrif … … 761 743 ENDIF 762 744 ! 745 CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 746 CALL wrk_dealloc( jpi,jpj, zc1 , u_oce1, u_oce2, u_ice2, zusw , v_oce1 , v_oce2, v_ice1 ) 747 CALL wrk_dealloc( jpi,jpj, zf1 , deltat, zu_ice, zf2 , deltac, zv_ice , zdd , zdt , zds ) 748 CALL wrk_dealloc( jpi,jpj, zdd , zdt , zds , zs1 , zs2 , zs12 , zresr ) 749 763 750 END SUBROUTINE lim_rhg 764 751 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r2715 r3148 24 24 USE iom ! I/O library 25 25 USE lib_mpp ! MPP library 26 USE wrk_nemo_2 ! work arrays 26 27 27 28 IMPLICIT NONE … … 92 93 !! ** purpose : output of sea-ice variable in a netcdf file 93 94 !!---------------------------------------------------------------------- 94 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released95 USE wrk_nemo, ONLY: z2d => wrk_2d_1 ! 2D workspace96 !97 95 INTEGER, INTENT(in) :: kt ! number of iteration 98 96 !! … … 101 99 CHARACTER(len=15) :: znam 102 100 CHARACTER(len=1) :: zchar, zchar1 103 !!---------------------------------------------------------------------- 104 105 IF( wrk_in_use(2, 1) ) THEN 106 CALL ctl_stop( 'lim_rst_write : requested workspace arrays unavailable' ) ; RETURN 107 END IF 101 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 102 !!---------------------------------------------------------------------- 103 104 CALL wrk_alloc( jpi, jpj, z2d ) 108 105 109 106 iter = kt + nn_fsbc - 1 ! ice restarts are written at kt == nitrst - nn_fsbc + 1 … … 295 292 ENDIF 296 293 ! 297 IF( wrk_not_released(2, 1) ) CALL ctl_stop( 'lim_rst_write : failed to release workspace arrays')294 CALL wrk_dealloc( jpi, jpj, z2d ) 298 295 ! 299 296 END SUBROUTINE lim_rst_write … … 306 303 !! ** purpose : read of sea-ice variable restart in a netcdf file 307 304 !!---------------------------------------------------------------------- 308 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released309 USE wrk_nemo, ONLY: z2d => wrk_2d_1 ! 2D workspace310 !311 305 INTEGER :: ji, jj, jk, jl, indx 312 306 REAL(wp) :: zfice, ziter 313 307 REAL(wp) :: zs_inf, z_slope_s, zsmax, zsmin, zalpha, zindb ! local scalars used for the salinity profile 314 REAL(wp), DIMENSION(nlay_i) :: zs_zero 308 REAL(wp), POINTER, DIMENSION(:) :: zs_zero 309 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 315 310 CHARACTER(len=15) :: znam 316 311 CHARACTER(len=1) :: zchar, zchar1 … … 319 314 !!---------------------------------------------------------------------- 320 315 321 IF( wrk_in_use(2, 1) ) THEN 322 CALL ctl_stop( 'lim_rst_read : requested workspace arrays unavailable.' ) ; RETURN 323 ENDIF 316 CALL wrk_alloc( nlay_i, zs_zero ) 317 CALL wrk_alloc( jpi, jpj, z2d ) 324 318 325 319 IF(lwp) THEN … … 570 564 CALL iom_close( numrir ) 571 565 ! 572 IF( wrk_not_released(2, 1) ) THEN 573 CALL ctl_stop( 'lim_rst_read : failed to release workspace arrays.' ) 574 END IF 566 CALL wrk_dealloc( nlay_i, zs_zero ) 567 CALL wrk_dealloc( jpi, jpj, z2d ) 575 568 ! 576 569 END SUBROUTINE lim_rst_read -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r2715 r3148 31 31 USE in_out_manager ! I/O manager 32 32 USE lib_mpp ! MPP library 33 USE wrk_nemo_2 ! work arrays 33 34 USE prtctl ! Print control 34 35 USE cpl_oasis3, ONLY : lk_cpl … … 93 94 !! Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 94 95 !!--------------------------------------------------------------------- 95 USE wrk_nemo, ONLY: wrk_not_released, wrk_in_use96 USE wrk_nemo, ONLY: zfcm1 => wrk_2d_1 , zfcm2 => wrk_2d_2 ! 2D workspace97 USE wrk_nemo, ONLY: wrk_3d_4, wrk_3d_5 ! 3D workspace98 !99 96 INTEGER, INTENT(in) :: kt ! number of iteration 100 97 ! … … 104 101 INTEGER :: iflt, ial, iadv, ifral, ifrdv 105 102 REAL(wp) :: zinda, zfons, zpme ! local scalars 106 !103 REAL(wp), POINTER, DIMENSION(:,:) :: zfcm1 , zfcm2 ! solar/non solar heat fluxes 107 104 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 108 105 !!--------------------------------------------------------------------- 109 110 IF( wrk_in_use(2, 1,2) .OR. wrk_in_use(3, 4,5) ) THEN 111 CALL ctl_stop( 'lim_sbc_flx : requested workspace arrays unavailable' ) ; RETURN 112 ENDIF 113 ! Set-up pointers to sub-arrays of 3d workspaces 114 zalb => wrk_3d_4(:,:,1:jpl) 115 zalbp => wrk_3d_5(:,:,1:jpl) 106 107 CALL wrk_alloc( jpi, jpj, zfcm1 , zfcm2 ) 108 IF( lk_cpl ) CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 116 109 117 110 !------------------------------------------! … … 297 290 ENDIF 298 291 ! 299 IF( wrk_not_released(2, 1,2) .OR. & 300 wrk_not_released(3, 4,5) ) & 301 CALL ctl_stop( 'lim_sbc_flx: failed to release workspace arrays' ) 292 CALL wrk_dealloc( jpi, jpj, zfcm1 , zfcm2 ) 293 IF( lk_cpl ) CALL wrk_dealloc( jpi, jpj, jpl, zalb, zalbp ) 302 294 ! 303 295 END SUBROUTINE lim_sbc_flx -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r2715 r3148 36 36 USE lbclnk ! lateral boundary condition - MPP links 37 37 USE lib_mpp ! MPP library 38 USE wrk_nemo_2 ! work arrays 38 39 USE in_out_manager ! I/O manager 39 40 USE prtctl ! Print control … … 81 82 !! ** References : H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 82 83 !!--------------------------------------------------------------------- 83 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released84 USE wrk_nemo, ONLY: zqlbsbq => wrk_2d_1 ! 2D workspace85 !86 84 INTEGER, INTENT(in) :: kt ! number of iteration 87 85 !! … … 92 90 REAL(wp) :: zinda, zindb, zthsnice, zfric_u ! local scalar 93 91 REAL(wp) :: zfntlat, zpareff, zareamin, zcoef ! - - 92 REAL(wp), POINTER, DIMENSION(:,:) :: zqlbsbq ! link with lead energy budget qldif 94 93 !!------------------------------------------------------------------- 95 94 96 IF( wrk_in_use(2, 1) ) THEN 97 CALL ctl_stop( 'lim_thd : requested workspace arrays unavailable' ) ; RETURN 98 ENDIF 95 CALL wrk_alloc( jpi, jpj, zqlbsbq ) 99 96 100 97 !------------------------------------------------------------------------------! … … 458 455 ENDIF 459 456 ! 460 IF( wrk_not_released(2, 1) ) CALL ctl_stop( 'lim_thd: failed to release workspace arrays')457 CALL wrk_dealloc( jpi, jpj, zqlbsbq ) 461 458 ! 462 459 END SUBROUTINE lim_thd -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r2777 r3148 21 21 USE par_ice ! LIM parameters 22 22 USE thd_ice ! LIM thermodynamics 23 USE wrk_nemo ! workspace manager24 23 USE in_out_manager ! I/O manager 25 24 USE lib_mpp ! MPP library 25 USE wrk_nemo_2 ! work arrays 26 26 27 27 IMPLICIT NONE … … 76 76 INTEGER :: i_ice_switch ! ice thickness above a certain treshold or not 77 77 INTEGER :: iter 78 INTEGER :: num_iter_max, numce_dh 79 80 REAL(wp) :: meance_dh 78 81 79 REAL(wp) :: zzfmass_i, zihgnew ! local scalar 82 80 REAL(wp) :: zzfmass_s, zhsnew, ztmelts ! local scalar … … 93 91 REAL(wp) :: ztform ! bottom formation temperature 94 92 ! 95 REAL(wp), POINTER, DIMENSION(:) :: zh_i, ztfs , zqfont_su, zqprec , zhgnew 96 REAL(wp), POINTER, DIMENSION(:) :: zh_s, zhsold, zqfont_bo, z_f_surf, zfmass_i 97 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_mel, zdh_s_sub , zfdt_init , zqt_i, zqt_dummy, zdq_i 98 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_pre, zfsalt_melt, zfdt_final, zqt_s, zfbase , zinnermelt 99 ! 100 REAL(wp), DIMENSION(jpij,jkmax) :: zdeltah 101 REAL(wp), DIMENSION(jpij,jkmax) :: zqt_i_lay ! total ice heat content 93 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness 94 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness 95 REAL(wp), POINTER, DIMENSION(:) :: ztfs ! melting point 96 REAL(wp), POINTER, DIMENSION(:) :: zhsold ! old snow thickness 97 REAL(wp), POINTER, DIMENSION(:) :: zqprec ! energy of fallen snow 98 REAL(wp), POINTER, DIMENSION(:) :: zqfont_su ! incoming, remaining surface energy 99 REAL(wp), POINTER, DIMENSION(:) :: zqfont_bo ! incoming, bottom energy 100 REAL(wp), POINTER, DIMENSION(:) :: z_f_surf ! surface heat for ablation 101 REAL(wp), POINTER, DIMENSION(:) :: zhgnew ! new ice thickness 102 REAL(wp), POINTER, DIMENSION(:) :: zfmass_i ! 103 104 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_mel ! snow melt 105 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_pre ! snow precipitation 106 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_sub ! snow sublimation 107 REAL(wp), POINTER, DIMENSION(:) :: zfsalt_melt ! salt flux due to ice melt 108 109 REAL(wp), POINTER, DIMENSION(:,:) :: zdeltah 110 111 ! Pathological cases 112 REAL(wp), POINTER, DIMENSION(:) :: zfdt_init ! total incoming heat for ice melt 113 REAL(wp), POINTER, DIMENSION(:) :: zfdt_final ! total remaing heat for ice melt 114 REAL(wp), POINTER, DIMENSION(:) :: zqt_i ! total ice heat content 115 REAL(wp), POINTER, DIMENSION(:) :: zqt_s ! total snow heat content 116 REAL(wp), POINTER, DIMENSION(:) :: zqt_dummy ! dummy heat content 117 118 REAL(wp), POINTER, DIMENSION(:,:) :: zqt_i_lay ! total ice heat content 119 120 ! Heat conservation 121 INTEGER :: num_iter_max, numce_dh 122 REAL(wp) :: meance_dh 123 REAL(wp), POINTER, DIMENSION(:) :: zinnermelt 124 REAL(wp), POINTER, DIMENSION(:) :: zfbase, zdq_i 102 125 !!------------------------------------------------------------------ 103 126 104 IF( wrk_in_use(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22) ) THEN 105 CALL ctl_stop('lim_thd_dh: requestead workspace arrays unavailable') ; RETURN 106 ENDIF 107 ! Set-up pointers to sub-arrays of workspace arrays 108 zh_i => wrk_1d_1 (1:jpij) ! ice layer thickness 109 zh_s => wrk_1d_2 (1:jpij) ! snow layer thickness 110 ztfs => wrk_1d_3 (1:jpij) ! melting point 111 zhsold => wrk_1d_4 (1:jpij) ! old snow thickness 112 zqprec => wrk_1d_5 (1:jpij) ! energy of fallen snow 113 zqfont_su => wrk_1d_6 (1:jpij) ! incoming, remaining surface energy 114 zqfont_bo => wrk_1d_7 (1:jpij) ! incoming, bottom energy 115 z_f_surf => wrk_1d_8 (1:jpij) ! surface heat for ablation 116 zhgnew => wrk_1d_9 (1:jpij) ! new ice thickness 117 zfmass_i => wrk_1d_10(1:jpij) ! 118 ! 119 zdh_s_mel => wrk_1d_11(1:jpij) ! snow melt 120 zdh_s_pre => wrk_1d_12(1:jpij) ! snow precipitation 121 zdh_s_sub => wrk_1d_13(1:jpij) ! snow sublimation 122 zfsalt_melt => wrk_1d_14(1:jpij) ! salt flux due to ice melt 123 ! 124 ! ! Pathological cases 125 zfdt_init => wrk_1d_15(1:jpij) ! total incoming heat for ice melt 126 zfdt_final => wrk_1d_16(1:jpij) ! total remaing heat for ice melt 127 zqt_i => wrk_1d_17(1:jpij) ! total ice heat content 128 zqt_s => wrk_1d_18(1:jpij) ! total snow heat content 129 zqt_dummy => wrk_1d_19(1:jpij) ! dummy heat content 130 131 zfbase => wrk_1d_20(1:jpij) 132 zdq_i => wrk_1d_21(1:jpij) 133 zinnermelt => wrk_1d_22(1:jpij) 127 CALL wrk_alloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 128 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfsalt_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 129 CALL wrk_alloc( jpij, zinnermelt, zfbase, zdq_i ) 130 CALL wrk_alloc( jpij, jkmax, zdeltah, zqt_i_lay ) 134 131 135 132 zfsalt_melt(:) = 0._wp … … 699 696 END DO !ji 700 697 ! 701 IF( wrk_not_released(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22) ) & 702 CALL ctl_stop('lim_thd_dh : failed to release workspace arrays') 698 CALL wrk_dealloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 699 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfsalt_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 700 CALL wrk_dealloc( jpij, zinnermelt, zfbase, zdq_i ) 701 CALL wrk_dealloc( jpij, jkmax, zdeltah, zqt_i_lay ) 703 702 ! 704 703 END SUBROUTINE lim_thd_dh -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r2777 r3148 22 22 USE in_out_manager ! I/O manager 23 23 USE lib_mpp ! MPP library 24 USE wrk_nemo_2 ! work arrays 24 25 25 26 IMPLICIT NONE … … 90 91 !! (04-2007) Energy conservation tested by M. Vancoppenolle 91 92 !!------------------------------------------------------------------ 92 INTEGER , INTENT (in) :: & 93 kideb , & ! Start point on which the the computation is applied 94 kiut , & ! End point on which the the computation is applied 95 jl ! Category number 93 INTEGER , INTENT (in) :: kideb ! Start point on which the the computation is applied 94 INTEGER , INTENT (in) :: kiut ! End point on which the the computation is applied 95 INTEGER , INTENT (in) :: jl ! Category number 96 96 97 97 !! * Local variables 98 INTEGER :: ji, & ! spatial loop index 99 ii, ij, & ! temporary dummy loop index 100 numeq, & ! current reference number of equation 101 layer, & ! vertical dummy loop index 102 nconv, & ! number of iterations in iterative procedure 103 minnumeqmin, maxnumeqmax 104 105 INTEGER , DIMENSION(kiut) :: & 106 numeqmin, & ! reference number of top equation 107 numeqmax, & ! reference number of bottom equation 108 isnow ! switch for presence (1) or absence (0) of snow 98 INTEGER :: ji ! spatial loop index 99 INTEGER :: ii, ij ! temporary dummy loop index 100 INTEGER :: numeq ! current reference number of equation 101 INTEGER :: layer ! vertical dummy loop index 102 INTEGER :: nconv ! number of iterations in iterative procedure 103 INTEGER :: minnumeqmin, maxnumeqmax 104 105 INTEGER , POINTER, DIMENSION(:) :: numeqmin ! reference number of top equation 106 INTEGER , POINTER, DIMENSION(:) :: numeqmax ! reference number of bottom equation 107 INTEGER , POINTER, DIMENSION(:) :: isnow ! switch for presence (1) or absence (0) of snow 109 108 110 109 !! * New local variables 111 REAL(wp) , DIMENSION(kiut,0:nlay_i) :: & 112 ztcond_i, & !Ice thermal conductivity 113 zradtr_i, & !Radiation transmitted through the ice 114 zradab_i, & !Radiation absorbed in the ice 115 zkappa_i !Kappa factor in the ice 116 117 REAL(wp) , DIMENSION(kiut,0:nlay_s) :: & 118 zradtr_s, & !Radiation transmited through the snow 119 zradab_s, & !Radiation absorbed in the snow 120 zkappa_s !Kappa factor in the snow 121 122 REAL(wp) , DIMENSION(kiut,0:nlay_i) :: & 123 ztiold, & !Old temperature in the ice 124 zeta_i, & !Eta factor in the ice 125 ztitemp, & !Temporary temperature in the ice to check the convergence 126 zspeche_i, & !Ice specific heat 127 z_i !Vertical cotes of the layers in the ice 128 129 REAL(wp) , DIMENSION(kiut,0:nlay_s) :: & 130 zeta_s, & !Eta factor in the snow 131 ztstemp, & !Temporary temperature in the snow to check the convergence 132 ztsold, & !Temporary temperature in the snow 133 z_s !Vertical cotes of the layers in the snow 134 135 REAL(wp) , DIMENSION(kiut,jkmax+2) :: & 136 zindterm, & ! Independent term 137 zindtbis, & ! temporary independent term 138 zdiagbis 139 140 REAL(wp) , DIMENSION(kiut,jkmax+2,3) :: ztrid ! tridiagonal system terms 141 142 REAL(wp), DIMENSION(kiut) :: & 143 ztfs , & ! ice melting point 144 ztsuold , & ! old surface temperature (before the iterative procedure ) 145 ztsuoldit, & ! surface temperature at previous iteration 146 zh_i , & !ice layer thickness 147 zh_s , & !snow layer thickness 148 zfsw , & !solar radiation absorbed at the surface 149 zf , & ! surface flux function 150 dzf ! derivative of the surface flux function 151 152 REAL(wp) :: & ! constant values 153 zeps = 1.e-10_wp, & ! 154 zg1s = 2._wp, & !: for the tridiagonal system 155 zg1 = 2._wp, & 156 zgamma = 18009._wp, & !: for specific heat 157 zbeta = 0.117_wp, & !: for thermal conductivity (could be 0.13) 158 zraext_s = 1.e+8_wp, & !: extinction coefficient of radiation in the snow 159 zkimin = 0.10_wp , & !: minimum ice thermal conductivity 160 zht_smin = 1.e-4_wp !: minimum snow depth 110 REAL(wp), POINTER, DIMENSION(:,:) :: ztcond_i !Ice thermal conductivity 111 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_i !Radiation transmitted through the ice 112 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_i !Radiation absorbed in the ice 113 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_i !Kappa factor in the ice 114 115 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_s !Radiation transmited through the snow 116 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_s !Radiation absorbed in the snow 117 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_s !Kappa factor in the snow 118 119 REAL(wp), POINTER, DIMENSION(:,:) :: ztiold !Old temperature in the ice 120 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_i !Eta factor in the ice 121 REAL(wp), POINTER, DIMENSION(:,:) :: ztitemp !Temporary temperature in the ice to check the convergence 122 REAL(wp), POINTER, DIMENSION(:,:) :: zspeche_i !Ice specific heat 123 REAL(wp), POINTER, DIMENSION(:,:) :: z_i !Vertical cotes of the layers in the ice 124 125 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_s !Eta factor in the snow 126 REAL(wp), POINTER, DIMENSION(:,:) :: ztstemp !Temporary temperature in the snow to check the convergence 127 REAL(wp), POINTER, DIMENSION(:,:) :: ztsold !Temporary temperature in the snow 128 REAL(wp), POINTER, DIMENSION(:,:) :: z_s !Vertical cotes of the layers in the snow 129 130 REAL(wp), POINTER, DIMENSION(:,:) :: zindterm ! Independent term 131 REAL(wp), POINTER, DIMENSION(:,:) :: zindtbis ! temporary independent term 132 REAL(wp), POINTER, DIMENSION(:,:) :: zdiagbis 133 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrid ! tridiagonal system terms 134 135 REAL(wp), POINTER, DIMENSION(:) :: ztfs ! ice melting point 136 REAL(wp), POINTER, DIMENSION(:) :: ztsuold ! old surface temperature (before the iterative procedure ) 137 REAL(wp), POINTER, DIMENSION(:) :: ztsuoldit ! surface temperature at previous iteration 138 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness 139 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness 140 REAL(wp), POINTER, DIMENSION(:) :: zfsw ! solar radiation absorbed at the surface 141 REAL(wp), POINTER, DIMENSION(:) :: zf ! surface flux function 142 REAL(wp), POINTER, DIMENSION(:) :: dzf ! derivative of the surface flux function 143 144 REAL(wp) :: zeps = 1.e-10_wp ! 145 REAL(wp) :: zg1s = 2._wp ! for the tridiagonal system 146 REAL(wp) :: zg1 = 2._wp ! 147 REAL(wp) :: zgamma = 18009._wp ! for specific heat 148 REAL(wp) :: zbeta = 0.117_wp ! for thermal conductivity (could be 0.13) 149 REAL(wp) :: zraext_s = 1.e+8_wp ! extinction coefficient of radiation in the snow 150 REAL(wp) :: zkimin = 0.10_wp ! minimum ice thermal conductivity 151 REAL(wp) :: zht_smin = 1.e-4_wp ! minimum snow depth 161 152 162 153 REAL(wp) :: ztmelt_i ! ice melting temperature 163 154 REAL(wp) :: zerritmax ! current maximal error on temperature 164 REAL(wp), DIMENSION(kiut) :: zerrit ! current error on temperature165 REAL(wp), DIMENSION(kiut) :: zdifcase ! case of the equation resolution (1->4)166 REAL(wp), DIMENSION(kiut) :: zftrice ! solar radiation transmitted through the ice167 REAL(wp), DIMENSION(kiut) :: zihic, zhsu155 REAL(wp), POINTER, DIMENSION(:) :: zerrit ! current error on temperature 156 REAL(wp), POINTER, DIMENSION(:) :: zdifcase ! case of the equation resolution (1->4) 157 REAL(wp), POINTER, DIMENSION(:) :: zftrice ! solar radiation transmitted through the ice 158 REAL(wp), POINTER, DIMENSION(:) :: zihic, zhsu 168 159 !!------------------------------------------------------------------ 169 160 ! 161 CALL wrk_alloc( kiut, numeqmin, numeqmax, isnow ) ! integer 162 CALL wrk_alloc( kiut,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztiold, zeta_i, ztitemp, zspeche_i, z_i, kjstart=0 ) 163 CALL wrk_alloc( kiut,nlay_s+1, zradtr_s, zradab_s, zkappa_s, zeta_s, ztstemp, ztsold, z_s, kjstart=0 ) 164 CALL wrk_alloc( kiut,jkmax+2, zindterm, zindtbis, zdiagbis ) 165 CALL wrk_alloc( kiut,jkmax+2,3, ztrid ) 166 CALL wrk_alloc( kiut, ztfs, ztsuold, ztsuoldit, zh_i, zh_s, zfsw, zf, dzf ) 167 CALL wrk_alloc( kiut, zerrit, zdifcase, zftrice, zihic, zhsu ) 168 170 169 !------------------------------------------------------------------------------! 171 170 ! 1) Initialization ! … … 773 772 ENDIF 774 773 ! 774 CALL wrk_dealloc( kiut, numeqmin, numeqmax, isnow ) ! integer 775 CALL wrk_dealloc( kiut,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztiold, zeta_i, ztitemp, zspeche_i, z_i, kjstart=0 ) 776 CALL wrk_dealloc( kiut,nlay_s+1, zradtr_s, zradab_s, zkappa_s, zeta_s, ztstemp, ztsold, z_s, kjstart=0 ) 777 CALL wrk_dealloc( kiut,jkmax+2, zindterm, zindtbis, zdiagbis ) 778 CALL wrk_dealloc( kiut,jkmax+2,3, ztrid ) 779 CALL wrk_dealloc( kiut, ztfs, ztsuold, ztsuoldit, zh_i, zh_s, zfsw, zf, dzf ) 780 CALL wrk_dealloc( kiut, zerrit, zdifcase, zftrice, zihic, zhsu ) 781 775 782 END SUBROUTINE lim_thd_dif 776 783 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
r2777 r3148 27 27 USE limvar ! LIM variables 28 28 USE in_out_manager ! I/O manager 29 USE wrk_nemo ! workspace manager30 29 USE lib_mpp ! MPP library 30 USE wrk_nemo_2 ! work arrays 31 31 32 32 IMPLICIT NONE 33 33 PRIVATE 34 34 35 PUBLIC lim_thd_ent ! called by lim_thd35 PUBLIC lim_thd_ent ! called by lim_thd 36 36 37 37 REAL(wp) :: epsi20 = 1e-20_wp ! constant values … … 48 48 !!---------------------------------------------------------------------- 49 49 CONTAINS 50 50 51 51 SUBROUTINE lim_thd_ent( kideb, kiut, jl ) 52 52 !!------------------------------------------------------------------- … … 97 97 zdiscrim !: dummy factor 98 98 99 INTEGER, DIMENSION(jpij) :: & 100 snswi , & ! snow switch 101 nbot0 , & ! old layer bottom index 102 icsuind , & ! ice surface index 103 icsuswi , & ! ice surface switch 104 icboind , & ! ice bottom index 105 icboswi , & ! ice bottom switch 106 snicind , & ! snow ice index 107 snicswi , & ! snow ice switch 108 snind ! snow index 109 ! 110 REAL(wp), DIMENSION(jpij,0:jkmax+3) :: zm0 ! old layer-system vertical cotes 111 REAL(wp), DIMENSION(jpij,0:jkmax+3) :: qm0 ! old layer-system heat content 112 REAL(wp), DIMENSION(jpij,0:jkmax+3) :: z_s ! new snow system vertical cotes 113 REAL(wp), DIMENSION(jpij,0:jkmax+3) :: z_i ! new ice system vertical cotes 114 REAL(wp), DIMENSION(jpij,0:jkmax+3) :: zthick0 ! old ice thickness 115 REAL(wp), DIMENSION(jpij,0:jkmax+3) :: zhl0 ! old and new layer thicknesses 116 ! 117 REAL(wp), DIMENSION(0:jkmax+3,0:jkmax+3) :: zrl01 118 ! 119 REAL(wp), POINTER, DIMENSION(:) :: zh_i, zqsnow , zqti_in, zqti_fin 120 REAL(wp), POINTER, DIMENSION(:) :: zh_s, zdeltah, zqts_in, zqts_fin 99 INTEGER, POINTER, DIMENSION(:) :: snswi ! snow switch 100 INTEGER, POINTER, DIMENSION(:) :: nbot0 ! old layer bottom index 101 INTEGER, POINTER, DIMENSION(:) :: icsuind ! ice surface index 102 INTEGER, POINTER, DIMENSION(:) :: icsuswi ! ice surface switch 103 INTEGER, POINTER, DIMENSION(:) :: icboind ! ice bottom index 104 INTEGER, POINTER, DIMENSION(:) :: icboswi ! ice bottom switch 105 INTEGER, POINTER, DIMENSION(:) :: snicind ! snow ice index 106 INTEGER, POINTER, DIMENSION(:) :: snicswi ! snow ice switch 107 INTEGER, POINTER, DIMENSION(:) :: snind ! snow index 108 ! 109 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! thickness of an ice layer 110 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! thickness of a snow layer 111 REAL(wp), POINTER, DIMENSION(:) :: zqsnow ! enthalpy of the snow put in snow ice 112 REAL(wp), POINTER, DIMENSION(:) :: zdeltah ! temporary variable 113 REAL(wp), POINTER, DIMENSION(:) :: zqti_in, zqts_in 114 REAL(wp), POINTER, DIMENSION(:) :: zqti_fin, zqts_fin 115 116 REAL(wp), POINTER, DIMENSION(:,:) :: zm0 ! old layer-system vertical cotes 117 REAL(wp), POINTER, DIMENSION(:,:) :: qm0 ! old layer-system heat content 118 REAL(wp), POINTER, DIMENSION(:,:) :: z_s ! new snow system vertical cotes 119 REAL(wp), POINTER, DIMENSION(:,:) :: z_i ! new ice system vertical cotes 120 REAL(wp), POINTER, DIMENSION(:,:) :: zthick0 ! old ice thickness 121 REAL(wp), POINTER, DIMENSION(:,:) :: zhl0 ! old and new layer thicknesses 122 REAL(wp), POINTER, DIMENSION(:,:) :: zrl01 121 123 !!------------------------------------------------------------------- 122 124 123 IF( wrk_in_use(1, 1,2,3,4,5,6,7,8) ) THEN 124 CALL ctl_stop('lim_thd_ent : requestead workspace arrays unavailable') ; RETURN 125 END IF 126 127 ! Set-up pointers to sub-arrays of workspace arrays 128 zh_i => wrk_1d_1 (1:jpij) ! thickness of an ice layer 129 zh_s => wrk_1d_2 (1:jpij) ! thickness of a snow layer 130 zqsnow => wrk_1d_3 (1:jpij) ! enthalpy of the snow put in snow ice 131 zdeltah => wrk_1d_4 (1:jpij) ! temporary variable 132 zqti_in => wrk_1d_5 (1:jpij) ! Energy conservation 133 zqts_in => wrk_1d_6 (1:jpij) ! - - 134 zqti_fin => wrk_1d_7 (1:jpij) ! - - 135 zqts_fin => wrk_1d_8 (1:jpij) ! - - 125 CALL wrk_alloc( jpij, snswi, nbot0, icsuind, icsuswi, icboind, icboswi, snicind, snicswi, snind ) ! integer 126 CALL wrk_alloc( jpij, zh_i, zh_s, zqsnow, zdeltah, zqti_in, zqts_in, zqti_fin, zqts_fin ) ! real 127 CALL wrk_alloc( jpij,jkmax+4, zm0, qm0, z_s, z_i, zthick0, zhl0, kjstart = 0 ) 128 CALL wrk_alloc( jkmax+4,jkmax+4, zrl01, kistart = 0, kjstart = 0 ) 136 129 137 130 zthick0(:,:) = 0._wp … … 687 680 END DO !jk 688 681 ! 689 IF( wrk_not_released(1, 1,2,3,4,5,6,7,8) ) CALL ctl_stop( 'lim_thd_ent : failed to release workspace arrays' ) 682 CALL wrk_dealloc( jpij, snswi, nbot0, icsuind, icsuswi, icboind, icboswi, snicind, snicswi, snind ) ! integer 683 CALL wrk_dealloc( jpij, zh_i, zh_s, zqsnow, zdeltah, zqti_in, zqts_in, zqti_fin, zqts_fin ) ! real 684 CALL wrk_dealloc( jpij,jkmax+4, zm0, qm0, z_s, z_i, zthick0, zhl0, kjstart = 0 ) 685 CALL wrk_dealloc( jkmax+4,jkmax+4, zrl01, kistart = 0, kjstart = 0 ) 690 686 ! 691 687 END SUBROUTINE lim_thd_ent -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r2777 r3148 26 26 USE limtab ! LIM 2D <==> 1D 27 27 USE limcons ! LIM conservation 28 USE wrk_nemo ! workspace manager29 28 USE in_out_manager ! I/O manager 30 29 USE lib_mpp ! MPP library 30 USE wrk_nemo_2 ! work arrays 31 31 32 32 IMPLICIT NONE … … 77 77 !! update ht_s_b, ht_i_b and tbif_1d(:,:) 78 78 !!------------------------------------------------------------------------ 79 USE wrk_nemo, ONLY : vt_i_init => wrk_2d_1 , vt_i_final => wrk_2d_4 , et_i_init => wrk_2d_780 USE wrk_nemo, ONLY : vt_s_init => wrk_2d_2 , vt_s_final => wrk_2d_5 , et_s_init => wrk_2d_881 USE wrk_nemo, ONLY : zvrel => wrk_2d_3 , et_i_final => wrk_2d_682 !83 79 INTEGER :: ji,jj,jk,jl,jm ! dummy loop indices 84 80 INTEGER :: layer, nbpac ! local integers … … 90 86 CHARACTER (len = 15) :: fieldid 91 87 ! 92 INTEGER, DIMENSION(jpij) :: zcatac ! indexes of categories where new ice grows 93 94 REAL(wp), DIMENSION(jpij,jpl) :: zhice_old ! previous ice thickness 95 REAL(wp), DIMENSION(jpij,jpl) :: zdummy ! dummy thickness of new ice 96 REAL(wp), DIMENSION(jpij,jpl) :: zdhicbot ! thickness of new ice which is accreted vertically 97 REAL(wp), DIMENSION(jpij,jpl) :: zv_old ! old volume of ice in category jl 98 REAL(wp), DIMENSION(jpij,jpl) :: za_old ! old area of ice in category jl 99 REAL(wp), DIMENSION(jpij,jpl) :: za_i_ac ! 1-D version of a_i 100 REAL(wp), DIMENSION(jpij,jpl) :: zv_i_ac ! 1-D version of v_i 101 REAL(wp), DIMENSION(jpij,jpl) :: zoa_i_ac ! 1-D version of oa_i 102 REAL(wp), DIMENSION(jpij,jpl) :: zsmv_i_ac ! 1-D version of smv_i 103 104 REAL(wp), DIMENSION(jpij,jkmax ,jpl) :: ze_i_ac !: 1-D version of e_i 105 REAL(wp), DIMENSION(jpij,jkmax+1,jpl) :: zqm0 ! old layer-system heat content 106 REAL(wp), DIMENSION(jpij,jkmax+1,jpl) :: zthick0 ! old ice thickness 107 108 REAL(wp), POINTER, DIMENSION(:) :: zv_newice, zh_newice, zs_newice, zdv_res, zat_i_ac , zdh_frazb, zqbgow 109 REAL(wp), POINTER, DIMENSION(:) :: za_newice, ze_newice, zo_newice, zda_res, zat_i_lev, zvrel_ac , zdhex 110 REAL(wp), POINTER, DIMENSION(:) :: zswinew 88 INTEGER , POINTER, DIMENSION(:) :: zcatac ! indexes of categories where new ice grows 89 REAL(wp), POINTER, DIMENSION(:) :: zswinew ! switch for new ice or not 90 91 REAL(wp), POINTER, DIMENSION(:) :: zv_newice ! volume of accreted ice 92 REAL(wp), POINTER, DIMENSION(:) :: za_newice ! fractional area of accreted ice 93 REAL(wp), POINTER, DIMENSION(:) :: zh_newice ! thickness of accreted ice 94 REAL(wp), POINTER, DIMENSION(:) :: ze_newice ! heat content of accreted ice 95 REAL(wp), POINTER, DIMENSION(:) :: zs_newice ! salinity of accreted ice 96 REAL(wp), POINTER, DIMENSION(:) :: zo_newice ! age of accreted ice 97 REAL(wp), POINTER, DIMENSION(:) :: zdv_res ! residual volume in case of excessive heat budget 98 REAL(wp), POINTER, DIMENSION(:) :: zda_res ! residual area in case of excessive heat budget 99 REAL(wp), POINTER, DIMENSION(:) :: zat_i_ac ! total ice fraction 100 REAL(wp), POINTER, DIMENSION(:) :: zat_i_lev ! total ice fraction for level ice only (type 1) 101 REAL(wp), POINTER, DIMENSION(:) :: zdh_frazb ! accretion of frazil ice at the ice bottom 102 REAL(wp), POINTER, DIMENSION(:) :: zvrel_ac ! relative ice / frazil velocity (1D vector) 103 104 REAL(wp), POINTER, DIMENSION(:,:) :: zhice_old ! previous ice thickness 105 REAL(wp), POINTER, DIMENSION(:,:) :: zdummy ! dummy thickness of new ice 106 REAL(wp), POINTER, DIMENSION(:,:) :: zdhicbot ! thickness of new ice which is accreted vertically 107 REAL(wp), POINTER, DIMENSION(:,:) :: zv_old ! old volume of ice in category jl 108 REAL(wp), POINTER, DIMENSION(:,:) :: za_old ! old area of ice in category jl 109 REAL(wp), POINTER, DIMENSION(:,:) :: za_i_ac ! 1-D version of a_i 110 REAL(wp), POINTER, DIMENSION(:,:) :: zv_i_ac ! 1-D version of v_i 111 REAL(wp), POINTER, DIMENSION(:,:) :: zoa_i_ac ! 1-D version of oa_i 112 REAL(wp), POINTER, DIMENSION(:,:) :: zsmv_i_ac ! 1-D version of smv_i 113 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze_i_ac !: 1-D version of e_i 115 116 REAL(wp), POINTER, DIMENSION(:) :: zqbgow ! heat budget of the open water (negative) 117 REAL(wp), POINTER, DIMENSION(:) :: zdhex ! excessively thick accreted sea ice (hlead-hice) 118 119 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqm0 ! old layer-system heat content 120 REAL(wp), POINTER, DIMENSION(:,:,:) :: zthick0 ! old ice thickness 121 122 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories 123 REAL(wp), POINTER, DIMENSION(:,:) :: vt_s_init, vt_s_final ! snow volume summed over categories 124 REAL(wp), POINTER, DIMENSION(:,:) :: et_i_init, et_i_final ! ice energy summed over categories 125 REAL(wp), POINTER, DIMENSION(:,:) :: et_s_init ! snow energy summed over categories 126 REAL(wp), POINTER, DIMENSION(:,:) :: zvrel ! relative ice / frazil velocity 111 127 !!-----------------------------------------------------------------------! 112 128 113 IF( wrk_in_use(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) .OR. & 114 & wrk_in_use(2, 1,2,3,4,5,6,7,8) ) THEN 115 CALL ctl_stop('lim_thd_lac : requestead workspace arrays unavailable.') ; RETURN 116 END IF 117 ! Set-up pointers to sub-arrays of workspace arrays 118 zv_newice => wrk_1d_1 (1:jpij) ! volume of accreted ice 119 za_newice => wrk_1d_2 (1:jpij) ! fractional area of accreted ice 120 zh_newice => wrk_1d_3 (1:jpij) ! thickness of accreted ice 121 ze_newice => wrk_1d_4 (1:jpij) ! heat content of accreted ice 122 zs_newice => wrk_1d_5 (1:jpij) ! salinity of accreted ice 123 zo_newice => wrk_1d_6 (1:jpij) ! age of accreted ice 124 zdv_res => wrk_1d_7 (1:jpij) ! residual volume in case of excessive heat budget 125 zda_res => wrk_1d_8 (1:jpij) ! residual area in case of excessive heat budget 126 zat_i_ac => wrk_1d_9 (1:jpij) ! total ice fraction 127 zat_i_lev => wrk_1d_10(1:jpij) ! total ice fraction for level ice only (type 1) 128 zdh_frazb => wrk_1d_11(1:jpij) ! accretion of frazil ice at the ice bottom 129 zvrel_ac => wrk_1d_12(1:jpij) ! relative ice / frazil velocity (1D vector) 130 zqbgow => wrk_1d_13(1:jpij) ! heat budget of the open water (negative) 131 zdhex => wrk_1d_14(1:jpij) ! excessively thick accreted sea ice (hlead-hice) 132 zswinew => wrk_1d_15(1:jpij) ! switch for new ice or not 133 134 129 CALL wrk_alloc( jpij, zcatac ) ! integer 130 CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 131 CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex ) 132 CALL wrk_alloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 133 CALL wrk_alloc( jpij,jkmax,jpl, ze_i_ac ) 134 CALL wrk_alloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) 135 CALL wrk_alloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, zvrel ) 135 136 136 137 et_i_init(:,:) = 0._wp … … 691 692 ENDIF 692 693 ! 693 IF( wrk_not_released(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) .OR. & 694 wrk_not_released(2, 1,2,3,4,5,6,7,8) ) & 695 CALL ctl_stop( 'lim_thd_lac : failed to release workspace arrays' ) 694 CALL wrk_dealloc( jpij, zcatac ) ! integer 695 CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 696 CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex ) 697 CALL wrk_dealloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 698 CALL wrk_dealloc( jpij,jkmax,jpl, ze_i_ac ) 699 CALL wrk_dealloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) 700 CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, zvrel ) 696 701 ! 697 702 END SUBROUTINE lim_thd_lac -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
r2777 r3148 22 22 USE limvar ! LIM variables 23 23 USE in_out_manager ! I/O manager 24 USE lib_mpp ! MPP library 24 USE lib_mpp ! MPP library 25 USE wrk_nemo_2 ! work arrays 25 26 26 27 IMPLICIT NONE … … 49 50 !! -> num_sal = 4 -> S = S(h) [Cox and Weeks 74] 50 51 !!--------------------------------------------------------------------- 51 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released52 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2, wrk_1d_353 !54 52 INTEGER, INTENT(in) :: kideb, kiut ! thickness category index 55 53 ! … … 58 56 REAL(wp) :: zsold, iflush, iaccrbo, igravdr, isnowic, i_ice_switch, ztmelts ! local scalars 59 57 REAL(wp) :: zaaa, zbbb, zccc, zdiscrim ! local scalars 60 !61 58 REAL(wp), POINTER, DIMENSION(:) :: ze_init, zhiold, zsiold 62 59 !!--------------------------------------------------------------------- 63 60 64 IF( wrk_in_use(1, 1,2,3) ) THEN 65 CALL ctl_stop('lim_thd_sal : requestead workspace arrays unavailable.') ; RETURN 66 END IF 67 ! Set-up pointers to sub-arrays of workspace arrays 68 ze_init => wrk_1d_1 (1:jpij) 69 zhiold => wrk_1d_2 (1:jpij) 70 zsiold => wrk_1d_3 (1:jpij) 61 CALL wrk_alloc( jpij, ze_init, zhiold, zsiold ) 71 62 72 63 !------------------------------------------------------------------------------| … … 240 231 ENDIF 241 232 ! 242 IF( wrk_not_released(1, 1,2,3) ) CALL ctl_stop( 'lim_thd_sal : failed to release workspace arrays')233 CALL wrk_dealloc( jpij, ze_init, zhiold, zsiold ) 243 234 ! 244 235 END SUBROUTINE lim_thd_sal -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r2777 r3148 25 25 USE lbclnk ! lateral boundary conditions -- MPP exchanges 26 26 USE lib_mpp ! MPP library 27 USE wrk_nemo_2 ! work arrays 27 28 USE prtctl ! Print control 28 29 … … 62 63 !! ** action : 63 64 !!--------------------------------------------------------------------- 64 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released65 USE wrk_nemo, ONLY: zs0at => wrk_2d_4 , zsm => wrk_2d_5 , zs0ow => wrk_2d_6 ! 2D workspace66 USE wrk_nemo, ONLY: wrk_3d_3, wrk_3d_4, wrk_3d_5, wrk_3d_6, wrk_3d_7, wrk_3d_8 ! 3D workspace67 !68 65 INTEGER, INTENT(in) :: kt ! number of iteration 69 66 ! … … 76 73 REAL(wp) :: ze , zsal , zage ! - - 77 74 ! 78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ! 3D pointer 75 REAL(wp), POINTER, DIMENSION(:,:) :: zui_u, zvi_v, zsm, zs0at, zs0ow 76 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi 77 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zs0e 79 78 !!--------------------------------------------------------------------- 80 79 81 IF( wrk_in_use(2, 4,5,6) .OR. wrk_in_use(3, 3,4,5,6,7,8) ) THEN 82 CALL ctl_stop( 'lim_trp : requested workspace arrays unavailable' ) ; RETURN 83 END IF 84 85 zs0ice => wrk_3d_3(:,:,1:jpl) ; zs0a => wrk_3d_5(:,:,1:jpl) ; zs0sm => wrk_3d_7(:,:,1:jpl) 86 zs0sn => wrk_3d_4(:,:,1:jpl) ; zs0c0 => wrk_3d_6(:,:,1:jpl) ; zs0oi => wrk_3d_8(:,:,1:jpl) 87 IF( kt == nit000 ) THEN 88 ALLOCATE( zs0e(jpi,jpj,jkmax,jpl), Stat = ierr ) 89 IF( lk_mpp ) CALL mpp_sum ( ierr ) 90 IF( ierr /= 0 ) CALL ctl_stop( 'lim_trp : failed to allocate zs0e array' ) 91 END IF 80 CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow ) 81 CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 82 CALL wrk_alloc( jpi, jpj, jkmax, jpl, zs0e ) 92 83 93 84 IF( numit == nstart .AND. lwp ) THEN … … 465 456 ENDIF 466 457 ! 467 IF( wrk_not_released(2, 4,5,6) .OR. wrk_not_released(3, 3,4,5,6,7,8) ) & 468 & CALL ctl_stop('lim_trp : failed to release workspace arrays') 458 CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow ) 459 CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 460 CALL wrk_dealloc( jpi, jpj, jkmax, jpl, zs0e ) 469 461 ! 470 462 END SUBROUTINE lim_trp -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limupdate.F90
r2715 r3148 35 35 USE prtctl ! Print control 36 36 USE lbclnk ! lateral boundary condition - MPP exchanges 37 USE wrk_nemo_2 ! work arrays 37 38 38 39 IMPLICIT NONE … … 85 86 REAL(wp) :: z_prescr_hi, zat_i_old, ztmelts, ze_s 86 87 87 LOGICAL , DIMENSION(jpi,jpj,jpl) :: internal_melt88 REAL(wp), DIMENSION(jkmax) :: zthick0, zqm0 ! thickness of the layers and heat contents for88 INTEGER , POINTER, DIMENSION(:,:,:) :: internal_melt 89 REAL(wp), POINTER, DIMENSION(:) :: zthick0, zqm0 ! thickness of the layers and heat contents for 89 90 !!------------------------------------------------------------------- 91 92 CALL wrk_alloc( jpi,jpj,jpl, internal_melt ) ! integer 93 CALL wrk_alloc( jkmax, zthick0, zqm0 ) 90 94 91 95 IF( ln_nicep ) THEN … … 456 460 ! 2.3) Melt of an internal layer 457 461 !--------------------------------- 458 internal_melt(:,:,:) = .false.462 internal_melt(:,:,:) = 0 459 463 460 464 DO jl = 1, jpl … … 471 475 ! WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl) 472 476 ! WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl) 473 internal_melt(ji,jj,jl) = .true.477 internal_melt(ji,jj,jl) = 1 474 478 ENDIF 475 479 END DO ! ji … … 481 485 DO jj = 1, jpj 482 486 DO ji = 1, jpi 483 IF( internal_melt(ji,jj,jl) ) THEN487 IF( internal_melt(ji,jj,jl) == 1 ) THEN 484 488 ! initial ice thickness 485 489 !----------------------- … … 576 580 ENDIF 577 581 578 internal_melt(:,:,:) = .false.582 internal_melt(:,:,:) = 0 579 583 580 584 ! Melt of snow … … 589 593 ! If snow energy of melting smaller then Lf 590 594 ! Then all snow melts and meltwater, heat go to the ocean 591 IF ( ze_s .LE. rhosn * lfus ) internal_melt(ji,jj,jl) = .true.595 IF ( ze_s .LE. rhosn * lfus ) internal_melt(ji,jj,jl) = 1 592 596 593 597 IF( ln_nicep ) THEN … … 611 615 DO jj = 1, jpj 612 616 DO ji = 1, jpi 613 IF ( internal_melt(ji,jj,jl) ) THEN617 IF ( internal_melt(ji,jj,jl) == 1 ) THEN 614 618 v_s(ji,jj,jl) = 0.0 615 619 e_s(ji,jj,1,jl) = 0.0 … … 1027 1031 ENDIF 1028 1032 1029 !--------------------- 1033 CALL wrk_dealloc( jpi,jpj,jpl, internal_melt ) ! integer 1034 CALL wrk_dealloc( jkmax, zthick0, zqm0 ) 1030 1035 1031 1036 END SUBROUTINE lim_update -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r2777 r3148 51 51 USE thd_ice ! LIM thermodynamics 52 52 USE in_out_manager ! I/O manager 53 USE lib_mpp ! MPP library 53 USE lib_mpp ! MPP library 54 USE wrk_nemo_2 ! work arrays 54 55 55 56 IMPLICIT NONE … … 297 298 !! ** References : Vancoppenolle et al., 2007 (in preparation) 298 299 !!------------------------------------------------------------------ 299 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released300 USE wrk_nemo, ONLY: wrk_3d_3, wrk_3d_4301 300 INTEGER :: ji, jj, jk, jl ! dummy loop index 302 301 REAL(wp) :: dummy_fac0, dummy_fac1, dummy_fac, zsal ! local scalar 303 302 REAL(wp) :: zind0, zind01, zindbal, zargtemp , zs_zero ! - - 304 !305 303 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_slope_s, zalpha ! 3D pointer 306 304 !!------------------------------------------------------------------ 307 305 308 IF( wrk_in_use( 3, 3,4 ) ) THEN 309 CALL ctl_stop( 'lim_var_salprof: requested workspace arrays unavailable' ) ; RETURN 310 END IF 311 312 z_slope_s => wrk_3d_3(:,:,1:jpl) ! slope of the salinity profile 313 zalpha => wrk_3d_4(:,:,1:jpl) ! weight factor for s between s_i_0 and s_i_1 306 CALL wrk_alloc( jpi, jpj, jpl, z_slope_s, zalpha ) 314 307 315 308 !--------------------------------------- … … 390 383 ENDIF ! num_sal 391 384 ! 392 IF( wrk_not_released(3, 3,4) ) CALL ctl_stop('lim_var_salprof: failed to release workspace arrays.')385 CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha ) 393 386 ! 394 387 END SUBROUTINE lim_var_salprof … … 433 426 !! Works with 1d vectors and is used by thermodynamic modules 434 427 !!------------------------------------------------------------------- 435 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released436 USE wrk_nemo, ONLY: wrk_1d_4437 428 INTEGER, INTENT(in) :: kideb, kiut ! thickness category index 438 429 ! … … 445 436 !!--------------------------------------------------------------------- 446 437 447 IF( wrk_in_use(1, 4) ) THEN 448 CALL ctl_stop('lim_var_salprof1d : requestead workspace arrays unavailable.') ; RETURN 449 END IF 450 ! Set-up pointers to sub-arrays of workspace arrays 451 z_slope_s => wrk_1d_4 (1:jpij) 438 CALL wrk_alloc( jpij, z_slope_s ) 452 439 453 440 !--------------------------------------- … … 514 501 ENDIF 515 502 ! 516 IF( wrk_not_released(1, 4) ) CALL ctl_stop( 'lim_var_salprof1d : failed to release workspace arrays')503 CALL wrk_dealloc( jpij, z_slope_s ) 517 504 ! 518 505 END SUBROUTINE lim_var_salprof1d -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r2777 r3148 23 23 USE lbclnk 24 24 USE lib_mpp ! MPP library 25 USE wrk_nemo_2 ! work arrays 25 26 USE par_ice 26 27 … … 48 49 REAL(wp) :: epsi16 = 1e-16_wp 49 50 REAL(wp) :: zzero = 0._wp 50 REAL(wp) :: zone = 1._wp 51 52 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: zcmo, zcmoa ! additional fields 53 51 REAL(wp) :: zone = 1._wp 54 52 !!---------------------------------------------------------------------- 55 53 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) … … 73 71 !! modif : 03/06/98 74 72 !!------------------------------------------------------------------- 75 USE wrk_nemo, ONLY: wrk_not_released, wrk_in_use76 USE wrk_nemo, ONLY: zfield => wrk_2d_1 ! 2D workspace77 USE wrk_nemo, ONLY: wrk_3d_3, wrk_3d_4, wrk_3d_5 ! 3D workspace78 !79 73 INTEGER, INTENT(in) :: kindic ! if kindic < 0 there has been an error somewhere 80 74 ! … … 83 77 REAL(wp),DIMENSION(1) :: zdept 84 78 REAL(wp) :: zsto, zjulian, zout, zindh, zinda, zindb 79 REAL(wp), POINTER, DIMENSION(:,:,:) :: zcmo, zcmoa 80 REAL(wp), POINTER, DIMENSION(:,: ) :: zfield 85 81 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmaskitd, zoi, zei 86 82 … … 93 89 !!------------------------------------------------------------------- 94 90 95 IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 3,4,5) ) THEN96 CALL ctl_stop( 'lim_wri : requested workspace arrays unavailable' ) ; RETURN97 ENDIF91 CALL wrk_alloc( jpi, jpj, zfield ) 92 CALL wrk_alloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 93 CALL wrk_alloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 98 94 99 95 ipl = jpl 100 96 101 zmaskitd => wrk_3d_3(:,:,1:jpl)102 zoi => wrk_3d_4(:,:,1:jpl)103 zei => wrk_3d_5(:,:,1:jpl)104 105 106 97 IF( numit == nstart ) THEN 107 98 108 ALLOCATE( ndex51(jpij), ndexitd(jpij*jpl), zcmo(jpi,jpj,jpnoumax), zcmoa(jpi,jpj,jpnoumax),STAT=ierr )99 ALLOCATE( ndex51(jpij), ndexitd(jpij*jpl), STAT=ierr ) 109 100 IF( lk_mpp ) CALL mpp_sum ( ierr ) 110 101 IF( ierr /= 0 ) THEN … … 354 345 ENDIF 355 346 356 IF( wrk_not_released(2, 1) .OR. wrk_not_released(3, 3,4,5) ) & 357 CALL ctl_stop( 'lim_wri: failed to release workspace arrays' ) 347 CALL wrk_dealloc( jpi, jpj, zfield ) 348 CALL wrk_dealloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 349 CALL wrk_dealloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 358 350 359 351 END SUBROUTINE lim_wri
Note: See TracChangeset
for help on using the changeset viewer.
