- Timestamp:
- 2017-04-13T16:21:08+02:00 (7 years ago)
- Location:
- branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 18 edited
-
limadv_prather.F90 (modified) (5 diffs)
-
limadv_umx.F90 (modified) (11 diffs)
-
limhdf.F90 (modified) (4 diffs)
-
limistate.F90 (modified) (3 diffs)
-
limitd_me.F90 (modified) (10 diffs)
-
limitd_th.F90 (modified) (8 diffs)
-
limrhg.F90 (modified) (4 diffs)
-
limrst.F90 (modified) (6 diffs)
-
limsbc.F90 (modified) (5 diffs)
-
limthd.F90 (modified) (4 diffs)
-
limthd_da.F90 (modified) (3 diffs)
-
limthd_dh.F90 (modified) (4 diffs)
-
limthd_dif.F90 (modified) (5 diffs)
-
limthd_ent.F90 (modified) (3 diffs)
-
limthd_lac.F90 (modified) (3 diffs)
-
limtrp.F90 (modified) (8 diffs)
-
limvar.F90 (modified) (7 diffs)
-
limwri.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limadv_prather.F90
r7646 r7910 21 21 USE prtctl ! Print control 22 22 USE lib_mpp ! MPP library 23 USE wrk_nemo ! work arrays24 23 USE lib_fortran ! to use key_nosignedzero 25 24 … … 65 64 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 66 65 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 67 REAL(wp), POINTER, DIMENSION(:,:) :: zf0 , zfx , zfy , zbet ! 2D workspace68 REAL(wp), POINTER, DIMENSION(:,:) :: zfm , zfxx , zfyy , zfxy ! - -69 REAL(wp), POINTER, DIMENSION(:,:) :: zalg, zalg1, zalg1q ! - -66 REAL(wp), DIMENSION(jpi,jpj) :: zf0 , zfx , zfy , zbet ! 2D workspace 67 REAL(wp), DIMENSION(jpi,jpj) :: zfm , zfxx , zfyy , zfxy ! - - 68 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - - 70 69 !--------------------------------------------------------------------- 71 70 72 CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )73 CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )74 71 75 72 ! Limitation of moments. … … 218 215 ENDIF 219 216 ! 220 CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )221 CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )222 217 ! 223 218 END SUBROUTINE lim_adv_x … … 250 245 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 251 246 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 252 REAL(wp), POINTER, DIMENSION(:,:) :: zf0, zfx , zfy , zbet ! 2D workspace253 REAL(wp), POINTER, DIMENSION(:,:) :: zfm, zfxx, zfyy, zfxy ! - -254 REAL(wp), POINTER, DIMENSION(:,:) :: zalg, zalg1, zalg1q ! - -247 REAL(wp), DIMENSION(jpi,jpj) :: zf0, zfx , zfy , zbet ! 2D workspace 248 REAL(wp), DIMENSION(jpi,jpj) :: zfm, zfxx, zfyy, zfxy ! - - 249 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - - 255 250 !--------------------------------------------------------------------- 256 251 257 CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )258 CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )259 252 260 253 ! Limitation of moments. … … 404 397 ENDIF 405 398 ! 406 CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )407 CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )408 399 ! 409 400 END SUBROUTINE lim_adv_y -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90
r7753 r7910 21 21 USE lbclnk ! lateral boundary conditions -- MPP exchanges 22 22 USE lib_mpp ! MPP library 23 USE wrk_nemo ! work arrays24 23 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 25 24 USE timing ! Timing … … 65 64 REAL(wp) :: zfp_ui, zfp_vj ! - - 66 65 REAL(wp) :: zfm_ui, zfm_vj ! - - 67 REAL(wp), POINTER, DIMENSION(:,:) :: zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v66 REAL(wp), DIMENSION(jpi,jpj) :: zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v 68 67 !!---------------------------------------------------------------------- 69 68 ! 70 69 IF( nn_timing == 1 ) CALL timing_start('lim_adv_umx') 71 70 ! 72 CALL wrk_alloc( jpi,jpj, zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v )73 71 ! 74 72 ! … … 146 144 ! 147 145 ! 148 CALL wrk_dealloc( jpi,jpj, zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v )149 146 ! 150 147 IF( nn_timing == 1 ) CALL timing_stop('lim_adv_umx') … … 174 171 INTEGER :: ji, jj ! dummy loop indices 175 172 REAL(wp) :: zc_box ! - - 176 REAL(wp), POINTER, DIMENSION(:,:) :: zzt173 REAL(wp), DIMENSION(jpi,jpj) :: zzt 177 174 !!---------------------------------------------------------------------- 178 175 ! 179 176 IF( nn_timing == 1 ) CALL timing_start('macho') 180 177 ! 181 CALL wrk_alloc( jpi,jpj, zzt )182 178 ! 183 179 IF( MOD( (kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==! … … 219 215 ENDIF 220 216 ! 221 CALL wrk_dealloc( jpi,jpj, zzt )222 217 ! 223 218 IF( nn_timing == 1 ) CALL timing_stop('macho') … … 245 240 INTEGER :: ji, jj ! dummy loop indices 246 241 REAL(wp) :: zcu, zdx2, zdx4 ! - - 247 REAL(wp), POINTER, DIMENSION(:,:) :: ztu1, ztu2, ztu3, ztu4242 REAL(wp), DIMENSION(jpi,jpj) :: ztu1, ztu2, ztu3, ztu4 248 243 !!---------------------------------------------------------------------- 249 244 ! 250 245 IF( nn_timing == 1 ) CALL timing_start('ultimate_x') 251 246 ! 252 CALL wrk_alloc( jpi,jpj, ztu1, ztu2, ztu3, ztu4 )253 247 ! 254 248 ! !-- Laplacian in i-direction --! … … 346 340 END SELECT 347 341 ! 348 CALL wrk_dealloc( jpi,jpj, ztu1, ztu2, ztu3, ztu4 )349 342 ! 350 343 IF( nn_timing == 1 ) CALL timing_stop('ultimate_x') … … 372 365 INTEGER :: ji, jj ! dummy loop indices 373 366 REAL(wp) :: zcv, zdy2, zdy4 ! - - 374 REAL(wp), POINTER, DIMENSION(:,:) :: ztv1, ztv2, ztv3, ztv4367 REAL(wp), DIMENSION(jpi,jpj) :: ztv1, ztv2, ztv3, ztv4 375 368 !!---------------------------------------------------------------------- 376 369 ! 377 370 IF( nn_timing == 1 ) CALL timing_start('ultimate_y') 378 371 ! 379 CALL wrk_alloc( jpi,jpj, ztv1, ztv2, ztv3, ztv4 )380 372 ! 381 373 ! !-- Laplacian in j-direction --! … … 474 466 END SELECT 475 467 ! 476 CALL wrk_dealloc( jpi,jpj, ztv1, ztv2, ztv3, ztv4 )477 468 ! 478 469 IF( nn_timing == 1 ) CALL timing_stop('ultimate_y') … … 502 493 REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zsml, z1_dt ! local scalars 503 494 REAL(wp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - - 504 REAL(wp), POINTER, DIMENSION(:,:) :: zbetup, zbetdo, zbup, zbdo, zmsk, zdiv495 REAL(wp), DIMENSION(jpi,jpj) :: zbetup, zbetdo, zbup, zbdo, zmsk, zdiv 505 496 !!---------------------------------------------------------------------- 506 497 ! 507 498 IF( nn_timing == 1 ) CALL timing_start('nonosc_2d') 508 499 ! 509 CALL wrk_alloc( jpi,jpj, zbetup, zbetdo, zbup, zbdo, zmsk, zdiv )510 500 ! 511 501 zbig = 1.e+40_wp … … 578 568 CALL lbc_lnk_multi( paa, 'U', -1., pbb, 'V', -1. ) ! lateral boundary condition (changed sign) 579 569 ! 580 CALL wrk_dealloc( jpi,jpj, zbetup, zbetdo, zbup, zbdo, zmsk, zdiv )581 570 ! 582 571 IF( nn_timing == 1 ) CALL timing_stop('nonosc_2d') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r7753 r7910 20 20 USE lbclnk ! lateral boundary condition - MPP exchanges 21 21 USE lib_mpp ! MPP library 22 USE wrk_nemo ! work arrays23 22 USE prtctl ! Print control 24 23 USE in_out_manager ! I/O manager … … 66 65 INTEGER , PARAMETER :: num_convfrq = 5 ! convergence check frequency of the Crant-Nicholson scheme (perf. optimization) 67 66 REAL(wp), POINTER, DIMENSION(:) :: zconv 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrlx, zdiv0, ztab069 REAL(wp), POINTER, DIMENSION(:,:) :: zflu, zflv, zdiv67 REAL(wp), DIMENSION(jpi,jpj,isize) :: zrlx, zdiv0, ztab0 68 REAL(wp), DIMENSION(jpi,jpj) :: zflu, zflv, zdiv 70 69 !!------------------------------------------------------------------- 71 70 TYPE(arrayptr) , ALLOCATABLE, DIMENSION(:) :: pt2d_array, zrlx_array … … 83 82 ALLOCATE( psgn_array(isize) ) 84 83 85 CALL wrk_alloc( jpi,jpj, zflu, zflv, zdiv )86 CALL wrk_alloc( jpi,jpj,isize, zrlx, zdiv0, ztab0 )87 84 88 85 DO jk= 1, isize … … 206 203 ENDIF 207 204 ! 208 CALL wrk_dealloc( jpi,jpj, zflu, zflv, zdiv )209 CALL wrk_dealloc( jpi,jpj,isize, zrlx, zdiv0, ztab0 )210 205 ! 211 206 DEALLOCATE( zconv ) -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r7761 r7910 28 28 USE lib_mpp ! MPP library 29 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 30 USE wrk_nemo ! work arrays31 30 USE fldread ! read input fields 32 31 USE iom … … 82 81 INTEGER :: i_hemis, i_fill, jl0 83 82 REAL(wp) :: zarg, zV, zconv, zdv 84 REAL(wp), POINTER, DIMENSION(:,:) :: zswitch ! ice indicator 85 REAL(wp), POINTER, DIMENSION(:,:) :: zht_i_ini, zat_i_ini, zvt_i_ini !data from namelist or nc file 86 REAL(wp), POINTER, DIMENSION(:,:) :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini !data by cattegories to fill 88 INTEGER , POINTER, DIMENSION(:) :: itest 89 !-------------------------------------------------------------------- 90 91 CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini, za_i_ini ) 92 CALL wrk_alloc( jpi, jpj, zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 93 CALL wrk_alloc( jpi, jpj, zswitch ) 94 Call wrk_alloc( 4, itest ) 83 REAL(wp), DIMENSION(jpi,jpj) :: zswitch ! ice indicator 84 REAL(wp), DIMENSION(jpi,jpj) :: zht_i_ini, zat_i_ini, zvt_i_ini !data from namelist or nc file 85 REAL(wp), DIMENSION(jpi,jpj) :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 86 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zh_i_ini, za_i_ini !data by cattegories to fill 87 INTEGER , DIMENSION(4) :: itest 88 !-------------------------------------------------------------------- 95 89 96 90 IF(lwp) WRITE(numout,*) … … 464 458 !!! 465 459 466 CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini, za_i_ini )467 CALL wrk_dealloc( jpi, jpj, zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )468 CALL wrk_dealloc( jpi, jpj, zswitch )469 460 Call wrk_dealloc( 4, itest ) 470 461 -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r7753 r7910 21 21 USE lbclnk ! lateral boundary condition - MPP exchanges 22 22 USE lib_mpp ! MPP library 23 USE wrk_nemo ! work arrays24 23 25 24 USE in_out_manager ! I/O manager … … 110 109 REAL(wp) :: za, zfac ! local scalar 111 110 CHARACTER (len = 15) :: fieldid 112 REAL(wp), POINTER, DIMENSION(:,:) :: closing_net ! net rate at which area is removed (1/s)111 REAL(wp), DIMENSION(jpi,jpj) :: closing_net ! net rate at which area is removed (1/s) 113 112 ! (ridging ice area - area of new ridges) / dt 114 REAL(wp), POINTER, DIMENSION(:,:) :: divu_adv ! divu as implied by transport scheme (1/s)115 REAL(wp), POINTER, DIMENSION(:,:) :: opning ! rate of opening due to divergence/shear116 REAL(wp), POINTER, DIMENSION(:,:) :: closing_gross ! rate at which area removed, not counting area of new ridges113 REAL(wp), DIMENSION(jpi,jpj) :: divu_adv ! divu as implied by transport scheme (1/s) 114 REAL(wp), DIMENSION(jpi,jpj) :: opning ! rate of opening due to divergence/shear 115 REAL(wp), DIMENSION(jpi,jpj) :: closing_gross ! rate at which area removed, not counting area of new ridges 117 116 ! 118 117 INTEGER, PARAMETER :: nitermax = 20 … … 122 121 IF( nn_timing == 1 ) CALL timing_start('limitd_me') 123 122 124 CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross )125 123 126 124 ! conservation test … … 289 287 IF( ln_ctl ) CALL lim_prt3D( 'limitd_me' ) 290 288 291 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross )292 289 ! 293 290 IF( nn_timing == 1 ) CALL timing_stop('limitd_me') … … 305 302 INTEGER :: ji,jj, jl ! dummy loop indices 306 303 REAL(wp) :: Gstari, astari, hrmean, zdummy ! local scalar 307 REAL(wp), POINTER, DIMENSION(:,:,:) :: Gsum ! Gsum(n) = sum of areas in categories 0 to n 308 !------------------------------------------------------------------------------! 309 310 CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 304 REAL(wp), DIMENSION(jpi,jpj,-1:jpl) :: Gsum ! Gsum(n) = sum of areas in categories 0 to n 305 !------------------------------------------------------------------------------! 306 311 307 312 308 Gstari = 1.0/rn_gstar … … 477 473 END DO 478 474 ! 479 CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )480 475 ! 481 476 END SUBROUTINE lim_itd_me_ridgeprep … … 501 496 REAL(wp) :: hL, hR, farea ! left and right limits of integration 502 497 503 INTEGER , POINTER, DIMENSION(:) :: indxi, indxj ! compressed indices504 REAL(wp), POINTER, DIMENSION(:) :: zswitch, fvol ! new ridge volume going to n2505 506 REAL(wp), POINTER, DIMENSION(:) :: afrac ! fraction of category area ridged507 REAL(wp), POINTER, DIMENSION(:) :: ardg1 , ardg2 ! area of ice ridged & new ridges508 REAL(wp), POINTER, DIMENSION(:) :: vsrdg , esrdg ! snow volume & energy of ridging ice509 REAL(wp), POINTER, DIMENSION(:) :: dhr , dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2510 511 REAL(wp), POINTER, DIMENSION(:) :: vrdg1 ! volume of ice ridged512 REAL(wp), POINTER, DIMENSION(:) :: vrdg2 ! volume of new ridges513 REAL(wp), POINTER, DIMENSION(:) :: vsw ! volume of seawater trapped into ridges514 REAL(wp), POINTER, DIMENSION(:) :: srdg1 ! sal*volume of ice ridged515 REAL(wp), POINTER, DIMENSION(:) :: srdg2 ! sal*volume of new ridges516 REAL(wp), POINTER, DIMENSION(:) :: smsw ! sal*volume of water trapped into ridges517 REAL(wp), POINTER, DIMENSION(:) :: oirdg1, oirdg2 ! ice age of ice ridged518 519 REAL(wp), POINTER, DIMENSION(:) :: afrft ! fraction of category area rafted520 REAL(wp), POINTER, DIMENSION(:) :: arft1 , arft2 ! area of ice rafted and new rafted zone521 REAL(wp), POINTER, DIMENSION(:) :: virft , vsrft ! ice & snow volume of rafting ice522 REAL(wp), POINTER, DIMENSION(:) :: esrft , smrft ! snow energy & salinity of rafting ice523 REAL(wp), POINTER, DIMENSION(:) :: oirft1, oirft2 ! ice age of ice rafted524 525 REAL(wp), POINTER, DIMENSION(:,:) :: eirft ! ice energy of rafting ice526 REAL(wp), POINTER, DIMENSION(:,:) :: erdg1 ! enth*volume of ice ridged527 REAL(wp), POINTER, DIMENSION(:,:) :: erdg2 ! enth*volume of new ridges528 REAL(wp), POINTER, DIMENSION(:,:) :: ersw ! enth of water trapped into ridges498 INTEGER , DIMENSION(jpij) :: indxi, indxj ! compressed indices 499 REAL(wp), DIMENSION(jpij) :: zswitch, fvol ! new ridge volume going to n2 500 501 REAL(wp), DIMENSION(jpij) :: afrac ! fraction of category area ridged 502 REAL(wp), DIMENSION(jpij) :: ardg1 , ardg2 ! area of ice ridged & new ridges 503 REAL(wp), DIMENSION(jpij) :: vsrdg , esrdg ! snow volume & energy of ridging ice 504 REAL(wp), DIMENSION(jpij) :: dhr , dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2 505 506 REAL(wp), DIMENSION(jpij) :: vrdg1 ! volume of ice ridged 507 REAL(wp), DIMENSION(jpij) :: vrdg2 ! volume of new ridges 508 REAL(wp), DIMENSION(jpij) :: vsw ! volume of seawater trapped into ridges 509 REAL(wp), DIMENSION(jpij) :: srdg1 ! sal*volume of ice ridged 510 REAL(wp), DIMENSION(jpij) :: srdg2 ! sal*volume of new ridges 511 REAL(wp), DIMENSION(jpij) :: smsw ! sal*volume of water trapped into ridges 512 REAL(wp), DIMENSION(jpij) :: oirdg1, oirdg2 ! ice age of ice ridged 513 514 REAL(wp), DIMENSION(jpij) :: afrft ! fraction of category area rafted 515 REAL(wp), DIMENSION(jpij) :: arft1 , arft2 ! area of ice rafted and new rafted zone 516 REAL(wp), DIMENSION(jpij) :: virft , vsrft ! ice & snow volume of rafting ice 517 REAL(wp), DIMENSION(jpij) :: esrft , smrft ! snow energy & salinity of rafting ice 518 REAL(wp), DIMENSION(jpij) :: oirft1, oirft2 ! ice age of ice rafted 519 520 REAL(wp), DIMENSION(jpij,nlay_i) :: eirft ! ice energy of rafting ice 521 REAL(wp), DIMENSION(jpij,nlay_i) :: erdg1 ! enth*volume of ice ridged 522 REAL(wp), DIMENSION(jpij,nlay_i) :: erdg2 ! enth*volume of new ridges 523 REAL(wp), DIMENSION(jpij,nlay_i) :: ersw ! enth of water trapped into ridges 529 524 !!---------------------------------------------------------------------- 530 525 531 CALL wrk_alloc( jpij, indxi, indxj )532 CALL wrk_alloc( jpij, zswitch, fvol )533 CALL wrk_alloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )534 CALL wrk_alloc( jpij, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 )535 CALL wrk_alloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )536 CALL wrk_alloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw )537 526 538 527 !------------------------------------------------------------------------------- … … 732 721 733 722 ! 734 CALL wrk_dealloc( jpij, indxi, indxj )735 CALL wrk_dealloc( jpij, zswitch, fvol )736 CALL wrk_dealloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )737 CALL wrk_dealloc( jpij, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 )738 CALL wrk_dealloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )739 CALL wrk_dealloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw )740 723 ! 741 724 END SUBROUTINE lim_itd_me_ridgeshift … … 760 743 INTEGER :: numts_rm ! number of time steps for the P smoothing 761 744 REAL(wp) :: zp, z1_3 ! local scalars 762 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here763 REAL(wp), POINTER, DIMENSION(:,:) :: zstrp1, zstrp2 ! strength at previous time steps745 REAL(wp), DIMENSION(jpi,jpj) :: zworka ! temporary array used here 746 REAL(wp), DIMENSION(jpi,jpj) :: zstrp1, zstrp2 ! strength at previous time steps 764 747 !!---------------------------------------------------------------------- 765 748 766 CALL wrk_alloc( jpi,jpj, zworka, zstrp1, zstrp2 )767 749 768 750 !------------------------------------------------------------------------------! … … 896 878 ENDIF ! ksmooth 897 879 898 CALL wrk_dealloc( jpi,jpj, zworka, zstrp1, zstrp2 )899 880 ! 900 881 END SUBROUTINE lim_itd_me_icestrength -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r7753 r7910 27 27 USE in_out_manager ! I/O manager 28 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! work arrays30 29 USE lib_fortran ! to use key_nosignedzero 31 30 USE limcons ! conservation tests … … 67 66 CHARACTER (len = 15) :: fieldid 68 67 69 INTEGER , POINTER, DIMENSION(:,:,:) :: zdonor ! donor category index70 71 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdhice ! ice thickness increment72 REAL(wp), POINTER, DIMENSION(:,:,:) :: g0 ! coefficients for fitting the line of the ITD73 REAL(wp), POINTER, DIMENSION(:,:,:) :: g1 ! coefficients for fitting the line of the ITD74 REAL(wp), POINTER, DIMENSION(:,:,:) :: hL ! left boundary for the ITD for each thickness75 REAL(wp), POINTER, DIMENSION(:,:,:) :: hR ! left boundary for the ITD for each thickness76 REAL(wp), POINTER, DIMENSION(:,:,:) :: zht_i_b ! old ice thickness77 REAL(wp), POINTER, DIMENSION(:,:,:) :: dummy_es78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdaice, zdvice ! local increment of ice area and volume79 REAL(wp), POINTER, DIMENSION(:) :: zvetamin, zvetamax ! maximum values for etas80 INTEGER , POINTER, DIMENSION(:) :: nind_i, nind_j ! compressed indices for i/j directions68 INTEGER , DIMENSION(jpi,jpj,jpl-1) :: zdonor ! donor category index 69 70 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zdhice ! ice thickness increment 71 REAL(wp), DIMENSION(jpi,jpj,jpl) :: g0 ! coefficients for fitting the line of the ITD 72 REAL(wp), DIMENSION(jpi,jpj,jpl) :: g1 ! coefficients for fitting the line of the ITD 73 REAL(wp), DIMENSION(jpi,jpj,jpl) :: hL ! left boundary for the ITD for each thickness 74 REAL(wp), DIMENSION(jpi,jpj,jpl) :: hR ! left boundary for the ITD for each thickness 75 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zht_i_b ! old ice thickness 76 REAL(wp), DIMENSION(jpi,jpj,jpl) :: dummy_es 77 REAL(wp), DIMENSION(jpi,jpj,jpl-1) :: zdaice, zdvice ! local increment of ice area and volume 78 REAL(wp), DIMENSION((jpi+1)*(jpj+1)) :: zvetamin, zvetamax ! maximum values for etas 79 INTEGER , DIMENSION((jpi+1)*(jpj+1)) :: nind_i, nind_j ! compressed indices for i/j directions 81 80 INTEGER :: nbrem ! number of cells with ice to transfer 82 81 REAL(wp) :: zslope ! used to compute local thermodynamic "speeds" 83 REAL(wp), POINTER, DIMENSION(:,:) :: zhb0, zhb1 ! category boundaries for thinnes categories 84 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories 85 REAL(wp), POINTER, DIMENSION(:,:) :: vt_s_init, vt_s_final ! snow volume summed over categories 86 REAL(wp), POINTER, DIMENSION(:,:) :: et_i_init, et_i_final ! ice energy summed over categories 87 REAL(wp), POINTER, DIMENSION(:,:) :: et_s_init, et_s_final ! snow energy summed over categories 88 INTEGER , POINTER, DIMENSION(:,:) :: zremap_flag ! compute remapping or not ???? 89 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhbnew ! new boundaries of ice categories 90 !!------------------------------------------------------------------ 91 92 CALL wrk_alloc( jpi,jpj, zremap_flag ) 93 CALL wrk_alloc( jpi,jpj,jpl-1, zdonor ) 94 CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 95 CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice ) 96 CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 ) 97 CALL wrk_alloc( (jpi+1)*(jpj+1), zvetamin, zvetamax ) 98 CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 99 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 ) 82 REAL(wp), DIMENSION(jpi,jpj) :: zhb0, zhb1 ! category boundaries for thinnes categories 83 REAL(wp), DIMENSION(jpi,jpj) :: vt_i_init, vt_i_final ! ice volume summed over categories 84 REAL(wp), DIMENSION(jpi,jpj) :: vt_s_init, vt_s_final ! snow volume summed over categories 85 REAL(wp), DIMENSION(jpi,jpj) :: et_i_init, et_i_final ! ice energy summed over categories 86 REAL(wp), DIMENSION(jpi,jpj) :: et_s_init, et_s_final ! snow energy summed over categories 87 INTEGER , DIMENSION(jpi,jpj) :: zremap_flag ! compute remapping or not ???? 88 REAL(wp), DIMENSION(jpi,jpj,0:jpl) :: zhbnew ! new boundaries of ice categories 89 !!------------------------------------------------------------------ 90 100 91 101 92 !!---------------------------------------------------------------------------------------------- … … 383 374 ENDIF 384 375 385 CALL wrk_dealloc( jpi,jpj, zremap_flag )386 CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )387 CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es )388 CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )389 CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )390 CALL wrk_dealloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )391 CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )392 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 )393 376 394 377 END SUBROUTINE lim_itd_th_rem … … 477 460 INTEGER :: ii, ij ! indices when changing from 2D-1D is done 478 461 479 REAL(wp), POINTER, DIMENSION(:,:,:) :: zaTsfn480 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here462 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zaTsfn 463 REAL(wp), DIMENSION(jpi,jpj) :: zworka ! temporary array used here 481 464 482 465 REAL(wp) :: zdvsnow, zdesnow ! snow volume and energy transferred … … 486 469 REAL(wp) :: zdaTsf ! aicen*Tsfcn transferred 487 470 488 INTEGER, POINTER, DIMENSION(:) :: nind_i, nind_j ! compressed indices for i/j directions471 INTEGER, DIMENSION((jpi+1)*(jpj+1)) :: nind_i, nind_j ! compressed indices for i/j directions 489 472 490 473 INTEGER :: nbrem ! number of cells with ice to transfer 491 474 !!------------------------------------------------------------------ 492 475 493 CALL wrk_alloc( jpi,jpj,jpl, zaTsfn )494 CALL wrk_alloc( jpi,jpj, zworka )495 CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )496 476 497 477 !---------------------------------------------------------------------------------------------- … … 621 601 END DO 622 602 ! 623 CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn )624 CALL wrk_dealloc( jpi,jpj, zworka )625 CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )626 603 ! 627 604 END SUBROUTINE lim_itd_shiftice … … 643 620 CHARACTER (len = 15) :: fieldid 644 621 645 INTEGER , POINTER, DIMENSION(:,:,:) :: zdonor ! donor category index646 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdaice, zdvice ! ice area and volume transferred647 648 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories649 REAL(wp), POINTER, DIMENSION(:,:) :: vt_s_init, vt_s_final ! snow volume summed over categories622 INTEGER , DIMENSION(jpi,jpj,jpl) :: zdonor ! donor category index 623 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zdaice, zdvice ! ice area and volume transferred 624 625 REAL(wp), DIMENSION(jpi,jpj) :: vt_i_init, vt_i_final ! ice volume summed over categories 626 REAL(wp), DIMENSION(jpi,jpj) :: vt_s_init, vt_s_final ! snow volume summed over categories 650 627 !!------------------------------------------------------------------ 651 628 652 CALL wrk_alloc( jpi,jpj,jpl, zdonor ) ! interger653 CALL wrk_alloc( jpi,jpj,jpl, zdaice, zdvice )654 CALL wrk_alloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final )655 629 ! 656 630 IF( con_i ) THEN ! conservation check … … 772 746 ENDIF 773 747 ! 774 CALL wrk_dealloc( jpi,jpj,jpl, zdonor )775 CALL wrk_dealloc( jpi,jpj,jpl, zdaice, zdvice )776 CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final )777 748 778 749 END SUBROUTINE lim_itd_th_reb -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r7753 r7910 28 28 USE lbclnk ! Lateral Boundary Condition / MPP link 29 29 USE lib_mpp ! MPP library 30 USE wrk_nemo ! work arrays31 30 USE in_out_manager ! I/O manager 32 31 USE prtctl ! Print control … … 123 122 REAL(wp) :: zintb, zintn ! dummy argument 124 123 125 REAL(wp), POINTER, DIMENSION(:,:) :: z1_e1t0, z1_e2t0 ! scale factors126 REAL(wp), POINTER, DIMENSION(:,:) :: zp_delt ! P/delta at T points124 REAL(wp), DIMENSION(jpi,jpj) :: z1_e1t0, z1_e2t0 ! scale factors 125 REAL(wp), DIMENSION(jpi,jpj) :: zp_delt ! P/delta at T points 127 126 ! 128 REAL(wp), POINTER, DIMENSION(:,:) :: zaU , zaV ! ice fraction on U/V points129 REAL(wp), POINTER, DIMENSION(:,:) :: zmU_t, zmV_t ! ice/snow mass/dt on U/V points130 REAL(wp), POINTER, DIMENSION(:,:) :: zmf ! coriolis parameter at T points131 REAL(wp), POINTER, DIMENSION(:,:) :: zTauU_ia , ztauV_ia ! ice-atm. stress at U-V points132 REAL(wp), POINTER, DIMENSION(:,:) :: zspgU , zspgV ! surface pressure gradient at U/V points133 REAL(wp), POINTER, DIMENSION(:,:) :: v_oceU, u_oceV, v_iceU, u_iceV ! ocean/ice u/v component on V/U points134 REAL(wp), POINTER, DIMENSION(:,:) :: zfU , zfV ! internal stresses127 REAL(wp), DIMENSION(jpi,jpj) :: zaU , zaV ! ice fraction on U/V points 128 REAL(wp), DIMENSION(jpi,jpj) :: zmU_t, zmV_t ! ice/snow mass/dt on U/V points 129 REAL(wp), DIMENSION(jpi,jpj) :: zmf ! coriolis parameter at T points 130 REAL(wp), DIMENSION(jpi,jpj) :: zTauU_ia , ztauV_ia ! ice-atm. stress at U-V points 131 REAL(wp), DIMENSION(jpi,jpj) :: zspgU , zspgV ! surface pressure gradient at U/V points 132 REAL(wp), DIMENSION(jpi,jpj) :: v_oceU, u_oceV, v_iceU, u_iceV ! ocean/ice u/v component on V/U points 133 REAL(wp), DIMENSION(jpi,jpj) :: zfU , zfV ! internal stresses 135 134 136 REAL(wp), POINTER, DIMENSION(:,:) :: zds ! shear137 REAL(wp), POINTER, DIMENSION(:,:) :: zs1, zs2, zs12 ! stress tensor components138 REAL(wp), POINTER, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! check convergence139 REAL(wp), POINTER, DIMENSION(:,:) :: zpice ! array used for the calculation of ice surface slope:135 REAL(wp), DIMENSION(jpi,jpj) :: zds ! shear 136 REAL(wp), DIMENSION(jpi,jpj) :: zs1, zs2, zs12 ! stress tensor components 137 REAL(wp), DIMENSION(jpi,jpj) :: zu_ice, zv_ice, zresr ! check convergence 138 REAL(wp), DIMENSION(jpi,jpj) :: zpice ! array used for the calculation of ice surface slope: 140 139 ! ocean surface (ssh_m) if ice is not embedded 141 140 ! ice top surface if ice is embedded 142 REAL(wp), POINTER, DIMENSION(:,:) :: zswitchU, zswitchV ! dummy arrays143 REAL(wp), POINTER, DIMENSION(:,:) :: zmaskU, zmaskV ! mask for ice presence144 REAL(wp), POINTER, DIMENSION(:,:) :: zfmask, zwf ! mask at F points for the ice141 REAL(wp), DIMENSION(jpi,jpj) :: zswitchU, zswitchV ! dummy arrays 142 REAL(wp), DIMENSION(jpi,jpj) :: zmaskU, zmaskV ! mask for ice presence 143 REAL(wp), DIMENSION(jpi,jpj) :: zfmask, zwf ! mask at F points for the ice 145 144 146 145 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter … … 149 148 !!------------------------------------------------------------------- 150 149 151 CALL wrk_alloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt )152 CALL wrk_alloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia )153 CALL wrk_alloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV )154 CALL wrk_alloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice )155 CALL wrk_alloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf )156 150 157 151 #if defined key_agrif … … 698 692 ! 699 693 700 CALL wrk_dealloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt )701 CALL wrk_dealloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia )702 CALL wrk_dealloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV )703 CALL wrk_dealloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice )704 CALL wrk_dealloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf )705 694 706 695 END SUBROUTINE lim_rhg -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r7813 r7910 24 24 USE iom ! I/O library 25 25 USE lib_mpp ! MPP library 26 USE wrk_nemo ! work arrays27 26 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 28 27 USE limctl … … 107 106 CHARACTER(len=25) :: znam 108 107 CHARACTER(len=2) :: zchar, zchar1 109 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 110 !!---------------------------------------------------------------------- 111 112 CALL wrk_alloc( jpi, jpj, z2d ) 108 REAL(wp), DIMENSION(jpi,jpj) :: z2d 109 !!---------------------------------------------------------------------- 110 113 111 114 112 iter = kt + nn_fsbc - 1 ! ice restarts are written at kt == nitrst - nn_fsbc + 1 … … 301 299 ENDIF 302 300 ! 303 CALL wrk_dealloc( jpi, jpj, z2d )304 301 ! 305 302 END SUBROUTINE lim_rst_write … … 314 311 INTEGER :: ji, jj, jk, jl 315 312 REAL(wp) :: zfice, ziter 316 REAL(wp), POINTER, DIMENSION(:,:) :: z2d313 REAL(wp), DIMENSION(jpi,jpj) :: z2d 317 314 CHARACTER(len=25) :: znam 318 315 CHARACTER(len=2) :: zchar, zchar1 … … 321 318 !!---------------------------------------------------------------------- 322 319 323 CALL wrk_alloc( jpi, jpj, z2d )324 320 325 321 IF(lwp) THEN … … 528 524 !CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90 529 525 ! 530 CALL wrk_dealloc( jpi, jpj, z2d )531 526 ! 532 527 END SUBROUTINE lim_rst_read -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r7753 r7910 42 42 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 43 43 USE lib_mpp ! MPP library 44 USE wrk_nemo ! work arrays45 44 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 46 45 … … 106 105 REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 107 106 REAL(wp) :: zqsr ! New solar flux received by the ocean 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 3D workspace109 REAL(wp), POINTER, DIMENSION(:,:) :: zalb ! 2D workspace107 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_cs, zalb_os ! 3D workspace 108 REAL(wp), DIMENSION(jpi,jpj) :: zalb ! 2D workspace 110 109 !!--------------------------------------------------------------------- 111 110 … … 121 120 122 121 ! albedo output 123 CALL wrk_alloc( jpi,jpj, zalb )124 122 125 123 zalb(:,:) = 0._wp … … 132 130 IF( iom_use('albedo' ) ) CALL iom_put( "albedo" , zalb(:,:) ) ! ice albedo output 133 131 134 CALL wrk_dealloc( jpi,jpj, zalb )135 132 136 133 DO jj = 1, jpj … … 210 207 ! Snow/ice albedo (only if sent to coupler, useless in forced mode) ! 211 208 !------------------------------------------------------------------------! 212 CALL wrk_alloc( jpi,jpj,jpl, zalb_cs, zalb_os )213 209 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 214 210 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 215 CALL wrk_dealloc( jpi,jpj,jpl, zalb_cs, zalb_os )216 211 217 212 ! conservation test -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r7813 r7910 41 41 USE lbclnk ! lateral boundary condition - MPP links 42 42 USE lib_mpp ! MPP library 43 USE wrk_nemo ! work arrays44 43 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 45 44 USE timing ! Timing … … 87 86 REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04) 88 87 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient 89 REAL(wp), POINTER, DIMENSION(:,:) :: zu_io, zv_io, zfric ! ice-ocean velocity (m/s) and frictional velocity (m2/s2)88 REAL(wp), DIMENSION(jpi,jpj) :: zu_io, zv_io, zfric ! ice-ocean velocity (m/s) and frictional velocity (m2/s2) 90 89 ! 91 90 !!------------------------------------------------------------------- … … 93 92 IF( nn_timing == 1 ) CALL timing_start('limthd') 94 93 95 CALL wrk_alloc( jpi,jpj, zu_io, zv_io, zfric )96 94 97 95 IF( kt == nit000 .AND. lwp ) THEN … … 342 340 IF( ln_ctl ) CALL lim_prt3D( 'limthd' ) 343 341 ! 344 CALL wrk_dealloc( jpi,jpj, zu_io, zv_io, zfric )345 342 ! 346 343 IF( nn_timing == 1 ) CALL timing_stop('limthd') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90
r7753 r7910 17 17 USE ice ! LIM variables 18 18 USE lib_mpp ! MPP library 19 USE wrk_nemo ! work arrays20 19 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 21 20 … … 104 103 REAL(wp), PARAMETER :: zm2 = 1.36_wp 105 104 ! 106 REAL(wp), POINTER, DIMENSION(:,:) :: zda_tot105 REAL(wp), DIMENSION(jpi,jpj) :: zda_tot 107 106 !!--------------------------------------------------------------------- 108 CALL wrk_alloc( jpi,jpj, zda_tot )109 107 110 108 !------------------------------------------------------------! … … 168 166 WHERE( a_i == 0._wp ) ht_i = 0._wp 169 167 ! 170 CALL wrk_dealloc( jpi,jpj, zda_tot )171 168 ! 172 169 END SUBROUTINE lim_thd_da -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r7646 r7910 23 23 USE in_out_manager ! I/O manager 24 24 USE lib_mpp ! MPP library 25 USE wrk_nemo ! work arrays26 25 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 27 26 … … 89 88 REAL(wp) :: zsstK ! SST in Kelvin 90 89 91 REAL(wp), POINTER, DIMENSION(:) :: zqprec ! energy of fallen snow (J.m-3)92 REAL(wp), POINTER, DIMENSION(:) :: zq_su ! heat for surface ablation (J.m-2)93 REAL(wp), POINTER, DIMENSION(:) :: zq_bo ! heat for bottom ablation (J.m-2)94 REAL(wp), POINTER, DIMENSION(:) :: zq_rema ! remaining heat at the end of the routine (J.m-2)95 REAL(wp), POINTER, DIMENSION(:) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2)96 REAL(wp), POINTER, DIMENSION(:) :: zevap_rema ! remaining mass flux from sublimation (kg.m-2)97 98 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_mel ! snow melt99 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_pre ! snow precipitation100 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_sub ! snow sublimation101 102 REAL(wp), POINTER, DIMENSION(:,:) :: zdeltah103 REAL(wp), POINTER, DIMENSION(:,:) :: zh_i ! ice layer thickness104 INTEGER , POINTER, DIMENSION(:,:) :: icount ! number of layers vanished by melting105 106 REAL(wp), POINTER, DIMENSION(:) :: zqh_i ! total ice heat content (J.m-2)107 REAL(wp), POINTER, DIMENSION(:) :: zsnw ! distribution of snow after wind blowing90 REAL(wp), DIMENSION(jpij) :: zqprec ! energy of fallen snow (J.m-3) 91 REAL(wp), DIMENSION(jpij) :: zq_su ! heat for surface ablation (J.m-2) 92 REAL(wp), DIMENSION(jpij) :: zq_bo ! heat for bottom ablation (J.m-2) 93 REAL(wp), DIMENSION(jpij) :: zq_rema ! remaining heat at the end of the routine (J.m-2) 94 REAL(wp), DIMENSION(jpij) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2) 95 REAL(wp), DIMENSION(jpij) :: zevap_rema ! remaining mass flux from sublimation (kg.m-2) 96 97 REAL(wp), DIMENSION(jpij) :: zdh_s_mel ! snow melt 98 REAL(wp), DIMENSION(jpij) :: zdh_s_pre ! snow precipitation 99 REAL(wp), DIMENSION(jpij) :: zdh_s_sub ! snow sublimation 100 101 REAL(wp), DIMENSION(jpij,nlay_i) :: zdeltah 102 REAL(wp), DIMENSION(jpij,nlay_i) :: zh_i ! ice layer thickness 103 INTEGER , DIMENSION(jpij,nlay_i) :: icount ! number of layers vanished by melting 104 105 REAL(wp), DIMENSION(jpij) :: zqh_i ! total ice heat content (J.m-2) 106 REAL(wp), DIMENSION(jpij) :: zsnw ! distribution of snow after wind blowing 108 107 109 108 REAL(wp) :: zswitch_sal … … 120 119 END SELECT 121 120 122 CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema )123 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i )124 CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i )125 CALL wrk_alloc( jpij, nlay_i, icount )126 121 127 122 zqprec (:) = 0._wp ; zq_su (:) = 0._wp ; zq_bo (:) = 0._wp ; zf_tt(:) = 0._wp … … 681 676 WHERE( ht_i_1d == 0._wp ) a_i_1d = 0._wp 682 677 683 CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema )684 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i )685 CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i )686 CALL wrk_dealloc( jpij, nlay_i, icount )687 678 ! 688 679 ! -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r7813 r7910 22 22 USE in_out_manager ! I/O manager 23 23 USE lib_mpp ! MPP library 24 USE wrk_nemo ! work arrays25 24 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 26 25 … … 99 98 INTEGER :: minnumeqmin, maxnumeqmax 100 99 101 INTEGER, POINTER, DIMENSION(:) :: numeqmin ! reference number of top equation102 INTEGER, POINTER, DIMENSION(:) :: numeqmax ! reference number of bottom equation100 INTEGER, DIMENSION(jpij) :: numeqmin ! reference number of top equation 101 INTEGER, DIMENSION(jpij) :: numeqmax ! reference number of bottom equation 103 102 104 103 REAL(wp) :: zg1s = 2._wp ! for the tridiagonal system … … 113 112 REAL(wp) :: zhsu 114 113 115 REAL(wp), POINTER, DIMENSION(:) :: isnow ! switch for presence (1) or absence (0) of snow116 REAL(wp), POINTER, DIMENSION(:) :: ztsub ! old surface temperature (before the iterative procedure )117 REAL(wp), POINTER, DIMENSION(:) :: ztsubit ! surface temperature at previous iteration118 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness119 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness120 REAL(wp), POINTER, DIMENSION(:) :: zfsw ! solar radiation absorbed at the surface121 REAL(wp), POINTER, DIMENSION(:) :: zqns_ice_b ! solar radiation absorbed at the surface122 REAL(wp), POINTER, DIMENSION(:) :: zf ! surface flux function123 REAL(wp), POINTER, DIMENSION(:) :: dzf ! derivative of the surface flux function124 REAL(wp), POINTER, DIMENSION(:) :: zerrit ! current error on temperature125 REAL(wp), POINTER, DIMENSION(:) :: zdifcase ! case of the equation resolution (1->4)126 REAL(wp), POINTER, DIMENSION(:) :: zftrice ! solar radiation transmitted through the ice127 REAL(wp), POINTER, DIMENSION(:) :: zihic114 REAL(wp), DIMENSION(jpij) :: isnow ! switch for presence (1) or absence (0) of snow 115 REAL(wp), DIMENSION(jpij) :: ztsub ! old surface temperature (before the iterative procedure ) 116 REAL(wp), DIMENSION(jpij) :: ztsubit ! surface temperature at previous iteration 117 REAL(wp), DIMENSION(jpij) :: zh_i ! ice layer thickness 118 REAL(wp), DIMENSION(jpij) :: zh_s ! snow layer thickness 119 REAL(wp), DIMENSION(jpij) :: zfsw ! solar radiation absorbed at the surface 120 REAL(wp), DIMENSION(jpij) :: zqns_ice_b ! solar radiation absorbed at the surface 121 REAL(wp), DIMENSION(jpij) :: zf ! surface flux function 122 REAL(wp), DIMENSION(jpij) :: dzf ! derivative of the surface flux function 123 REAL(wp), DIMENSION(jpij) :: zerrit ! current error on temperature 124 REAL(wp), DIMENSION(jpij) :: zdifcase ! case of the equation resolution (1->4) 125 REAL(wp), DIMENSION(jpij) :: zftrice ! solar radiation transmitted through the ice 126 REAL(wp), DIMENSION(jpij) :: zihic 128 127 129 REAL(wp), POINTER, DIMENSION(:,:) :: ztcond_i ! Ice thermal conductivity130 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_i ! Radiation transmitted through the ice131 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_i ! Radiation absorbed in the ice132 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_i ! Kappa factor in the ice133 REAL(wp), POINTER, DIMENSION(:,:) :: ztib ! Old temperature in the ice134 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_i ! Eta factor in the ice135 REAL(wp), POINTER, DIMENSION(:,:) :: ztitemp ! Temporary temperature in the ice to check the convergence136 REAL(wp), POINTER, DIMENSION(:,:) :: zspeche_i ! Ice specific heat137 REAL(wp), POINTER, DIMENSION(:,:) :: z_i ! Vertical cotes of the layers in the ice138 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_s ! Radiation transmited through the snow139 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_s ! Radiation absorbed in the snow140 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_s ! Kappa factor in the snow141 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_s ! Eta factor in the snow142 REAL(wp), POINTER, DIMENSION(:,:) :: ztstemp ! Temporary temperature in the snow to check the convergence143 REAL(wp), POINTER, DIMENSION(:,:) :: ztsb ! Temporary temperature in the snow144 REAL(wp), POINTER, DIMENSION(:,:) :: z_s ! Vertical cotes of the layers in the snow145 REAL(wp), POINTER, DIMENSION(:,:) :: zindterm ! 'Ind'ependent term146 REAL(wp), POINTER, DIMENSION(:,:) :: zindtbis ! Temporary 'ind'ependent term147 REAL(wp), POINTER, DIMENSION(:,:) :: zdiagbis ! Temporary 'dia'gonal term148 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrid ! Tridiagonal system terms128 REAL(wp), DIMENSION(jpij,nlay_i+1) :: ztcond_i ! Ice thermal conductivity 129 REAL(wp), DIMENSION(jpij,nlay_i+1) :: zradtr_i ! Radiation transmitted through the ice 130 REAL(wp), DIMENSION(jpij,nlay_i+1) :: zradab_i ! Radiation absorbed in the ice 131 REAL(wp), DIMENSION(jpij,nlay_i+1) :: zkappa_i ! Kappa factor in the ice 132 REAL(wp), DIMENSION(jpij,nlay_i+1) :: ztib ! Old temperature in the ice 133 REAL(wp), DIMENSION(jpij,nlay_i+1) :: zeta_i ! Eta factor in the ice 134 REAL(wp), DIMENSION(jpij,nlay_i+1) :: ztitemp ! Temporary temperature in the ice to check the convergence 135 REAL(wp), DIMENSION(jpij,nlay_i+1) :: zspeche_i ! Ice specific heat 136 REAL(wp), DIMENSION(jpij,nlay_i+1) :: z_i ! Vertical cotes of the layers in the ice 137 REAL(wp), DIMENSION(jpij,nlay_s+1) :: zradtr_s ! Radiation transmited through the snow 138 REAL(wp), DIMENSION(jpij,nlay_s+1) :: zradab_s ! Radiation absorbed in the snow 139 REAL(wp), DIMENSION(jpij,nlay_s+1) :: zkappa_s ! Kappa factor in the snow 140 REAL(wp), DIMENSION(jpij,nlay_s+1) :: zeta_s ! Eta factor in the snow 141 REAL(wp), DIMENSION(jpij,nlay_s+1) :: ztstemp ! Temporary temperature in the snow to check the convergence 142 REAL(wp), DIMENSION(jpij,nlay_s+1) :: ztsb ! Temporary temperature in the snow 143 REAL(wp), DIMENSION(jpij,nlay_s+1) :: z_s ! Vertical cotes of the layers in the snow 144 REAL(wp), DIMENSION(jpij,nlay_i+3) :: zindterm ! 'Ind'ependent term 145 REAL(wp), DIMENSION(jpij,nlay_i+3) :: zindtbis ! Temporary 'ind'ependent term 146 REAL(wp), DIMENSION(jpij,nlay_i+3) :: zdiagbis ! Temporary 'dia'gonal term 147 REAL(wp), DIMENSION(jpij,nlay_i+3,3) :: ztrid ! Tridiagonal system terms 149 148 150 149 ! diag errors on heat 151 REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err150 REAL(wp), DIMENSION(jpij) :: zdq, zq_ini, zhfx_err 152 151 153 152 ! Mono-category … … 162 161 REAL(wp) :: zheshth ! dummy factor 163 162 164 REAL(wp), POINTER, DIMENSION(:) :: zghe ! G(he), th. conduct enhancement factor, mono-cat163 REAL(wp), DIMENSION(jpij) :: zghe ! G(he), th. conduct enhancement factor, mono-cat 165 164 166 165 !!------------------------------------------------------------------ 167 166 ! 168 CALL wrk_alloc( jpij, numeqmin, numeqmax ) 169 CALL wrk_alloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw ) 170 CALL wrk_alloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe ) 171 CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 ) 172 CALL wrk_alloc( jpij,nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 ) 173 CALL wrk_alloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis ) 174 CALL wrk_alloc( jpij,nlay_i+3,3, ztrid ) 175 176 CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err ) 167 177 168 178 169 ! --- diag error on heat diffusion - PART 1 --- ! … … 792 783 END DO 793 784 ! 794 CALL wrk_dealloc( jpij, numeqmin, numeqmax )795 CALL wrk_dealloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw )796 CALL wrk_dealloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe )797 CALL wrk_dealloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 )798 CALL wrk_dealloc( jpij,nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 )799 CALL wrk_dealloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis )800 CALL wrk_dealloc( jpij,nlay_i+3,3, ztrid )801 CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err )802 785 803 786 END SUBROUTINE lim_thd_dif -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
r5134 r7910 29 29 USE in_out_manager ! I/O manager 30 30 USE lib_mpp ! MPP library 31 USE wrk_nemo ! work arrays32 31 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 33 32 … … 76 75 INTEGER :: jk0, jk1 ! old/new layer indices 77 76 ! 78 REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum0, zh_cum0 ! old cumulative enthlapies and layers interfaces79 REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum1, zh_cum1 ! new cumulative enthlapies and layers interfaces80 REAL(wp), POINTER, DIMENSION(:) :: zhnew ! new layers thicknesses77 REAL(wp), DIMENSION(jpij,0:nlay_i+2) :: zqh_cum0, zh_cum0 ! old cumulative enthlapies and layers interfaces 78 REAL(wp), DIMENSION(jpij,0:nlay_i) :: zqh_cum1, zh_cum1 ! new cumulative enthlapies and layers interfaces 79 REAL(wp), DIMENSION(jpij) :: zhnew ! new layers thicknesses 81 80 !!------------------------------------------------------------------- 82 81 83 CALL wrk_alloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 )84 CALL wrk_alloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 )85 CALL wrk_alloc( jpij, zhnew )86 82 87 83 !-------------------------------------------------------------------------- … … 146 142 147 143 ! 148 CALL wrk_dealloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 )149 CALL wrk_dealloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 )150 CALL wrk_dealloc( jpij, zhnew )151 144 ! 152 145 END SUBROUTINE lim_thd_ent -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r7753 r7910 26 26 USE in_out_manager ! I/O manager 27 27 USE lib_mpp ! MPP library 28 USE wrk_nemo ! work arrays29 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 30 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 85 84 REAL(wp) :: zv_newfra 86 85 87 INTEGER , POINTER, DIMENSION(:) :: jcat ! indexes of categories where new ice grows88 REAL(wp), POINTER, DIMENSION(:) :: zswinew ! switch for new ice or not89 90 REAL(wp), POINTER, DIMENSION(:) :: zv_newice ! volume of accreted ice91 REAL(wp), POINTER, DIMENSION(:) :: za_newice ! fractional area of accreted ice92 REAL(wp), POINTER, DIMENSION(:) :: zh_newice ! thickness of accreted ice93 REAL(wp), POINTER, DIMENSION(:) :: ze_newice ! heat content of accreted ice94 REAL(wp), POINTER, DIMENSION(:) :: zs_newice ! salinity of accreted ice95 REAL(wp), POINTER, DIMENSION(:) :: zo_newice ! age of accreted ice96 REAL(wp), POINTER, DIMENSION(:) :: zdv_res ! residual volume in case of excessive heat budget97 REAL(wp), POINTER, DIMENSION(:) :: zda_res ! residual area in case of excessive heat budget98 REAL(wp), POINTER, DIMENSION(:) :: zat_i_1d ! total ice fraction99 REAL(wp), POINTER, DIMENSION(:) :: zv_frazb ! accretion of frazil ice at the ice bottom100 REAL(wp), POINTER, DIMENSION(:) :: zvrel_1d ! relative ice / frazil velocity (1D vector)101 102 REAL(wp), POINTER, DIMENSION(:,:) :: zv_b ! old volume of ice in category jl103 REAL(wp), POINTER, DIMENSION(:,:) :: za_b ! old area of ice in category jl104 REAL(wp), POINTER, DIMENSION(:,:) :: za_i_1d ! 1-D version of a_i105 REAL(wp), POINTER, DIMENSION(:,:) :: zv_i_1d ! 1-D version of v_i106 REAL(wp), POINTER, DIMENSION(:,:) :: zsmv_i_1d ! 1-D version of smv_i107 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze_i_1d !: 1-D version of e_i109 110 REAL(wp), POINTER, DIMENSION(:,:) :: zvrel ! relative ice / frazil velocity86 INTEGER , DIMENSION(jpij) :: jcat ! indexes of categories where new ice grows 87 REAL(wp), DIMENSION(jpij) :: zswinew ! switch for new ice or not 88 89 REAL(wp), DIMENSION(jpij) :: zv_newice ! volume of accreted ice 90 REAL(wp), DIMENSION(jpij) :: za_newice ! fractional area of accreted ice 91 REAL(wp), DIMENSION(jpij) :: zh_newice ! thickness of accreted ice 92 REAL(wp), DIMENSION(jpij) :: ze_newice ! heat content of accreted ice 93 REAL(wp), DIMENSION(jpij) :: zs_newice ! salinity of accreted ice 94 REAL(wp), DIMENSION(jpij) :: zo_newice ! age of accreted ice 95 REAL(wp), DIMENSION(jpij) :: zdv_res ! residual volume in case of excessive heat budget 96 REAL(wp), DIMENSION(jpij) :: zda_res ! residual area in case of excessive heat budget 97 REAL(wp), DIMENSION(jpij) :: zat_i_1d ! total ice fraction 98 REAL(wp), DIMENSION(jpij) :: zv_frazb ! accretion of frazil ice at the ice bottom 99 REAL(wp), DIMENSION(jpij) :: zvrel_1d ! relative ice / frazil velocity (1D vector) 100 101 REAL(wp), DIMENSION(jpij,jpl) :: zv_b ! old volume of ice in category jl 102 REAL(wp), DIMENSION(jpij,jpl) :: za_b ! old area of ice in category jl 103 REAL(wp), DIMENSION(jpij,jpl) :: za_i_1d ! 1-D version of a_i 104 REAL(wp), DIMENSION(jpij,jpl) :: zv_i_1d ! 1-D version of v_i 105 REAL(wp), DIMENSION(jpij,jpl) :: zsmv_i_1d ! 1-D version of smv_i 106 107 REAL(wp), DIMENSION(jpij,nlay_i,jpl) :: ze_i_1d !: 1-D version of e_i 108 109 REAL(wp), DIMENSION(jpi,jpj) :: zvrel ! relative ice / frazil velocity 111 110 112 111 REAL(wp) :: zcai = 1.4e-3_wp ! ice-air drag (clem: should be dependent on coupling/forcing used) 113 112 !!-----------------------------------------------------------------------! 114 113 115 CALL wrk_alloc( jpij, jcat ) ! integer116 CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )117 CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )118 CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )119 CALL wrk_alloc( jpij,nlay_i,jpl, ze_i_1d )120 CALL wrk_alloc( jpi,jpj, zvrel )121 114 122 115 CALL lim_var_agg(1) … … 512 505 513 506 ! 514 CALL wrk_dealloc( jpij, jcat ) ! integer515 CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )516 CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )517 CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )518 CALL wrk_dealloc( jpij,nlay_i,jpl, ze_i_1d )519 CALL wrk_dealloc( jpi,jpj, zvrel )520 507 ! 521 508 END SUBROUTINE lim_thd_lac -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r7753 r7910 26 26 USE lbclnk ! lateral boundary conditions -- MPP exchanges 27 27 USE lib_mpp ! MPP library 28 USE wrk_nemo ! work arrays29 28 USE prtctl ! Print control 30 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 72 71 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 73 72 REAL(wp) :: zdv, zda 74 REAL(wp), POINTER, DIMENSION(:,:) :: zatold, zeiold, zesold, zsmvold75 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhimax, zviold, zvsold73 REAL(wp), DIMENSION(jpi,jpj) :: zatold, zeiold, zesold, zsmvold 74 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhimax, zviold, zvsold 76 75 ! --- diffusion --- ! 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhdfptab76 REAL(wp), DIMENSION(jpi,jpj,jpl*(ihdf_vars+nlay_i)+1) :: zhdfptab 78 77 INTEGER , PARAMETER :: ihdf_vars = 6 ! Number of variables in which we apply horizontal diffusion 79 78 ! inside limtrp for each ice category , not counting the … … 81 80 ! --- ultimate macho only --- ! 82 81 REAL(wp) :: zdt 83 REAL(wp), POINTER, DIMENSION(:,:) :: zudy, zvdx, zcu_box, zcv_box82 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx, zcu_box, zcv_box 84 83 ! --- prather only --- ! 85 REAL(wp), POINTER, DIMENSION(:,:) :: zarea86 REAL(wp), POINTER, DIMENSION(:,:,:) :: z0opw87 REAL(wp), POINTER, DIMENSION(:,:,:) :: z0ice, z0snw, z0ai, z0es , z0smi , z0oi88 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: z0ei84 REAL(wp), DIMENSION(jpi,jpj) :: zarea 85 REAL(wp), DIMENSION(jpi,jpj,1) :: z0opw 86 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z0ice, z0snw, z0ai, z0es , z0smi , z0oi 87 REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) :: z0ei 89 88 !! 90 89 !!--------------------------------------------------------------------- 91 90 IF( nn_timing == 1 ) CALL timing_start('limtrp') 92 91 93 CALL wrk_alloc( jpi,jpj, zatold, zeiold, zesold, zsmvold )94 CALL wrk_alloc( jpi,jpj,jpl, zhimax, zviold, zvsold )95 CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab)96 92 97 93 IF( kt == nit000 .AND. lwp ) THEN … … 163 159 !=============================! 164 160 165 CALL wrk_alloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box )166 161 167 162 IF( kt == nit000 .AND. lwp ) THEN … … 213 208 END DO 214 209 ! 215 CALL wrk_dealloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box )216 210 217 211 !=============================! … … 219 213 !=============================! 220 214 221 CALL wrk_alloc( jpi,jpj, zarea )222 CALL wrk_alloc( jpi,jpj,1, z0opw )223 CALL wrk_alloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi )224 CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei )225 215 226 216 IF( kt == nit000 .AND. lwp ) THEN … … 354 344 END DO 355 345 356 CALL wrk_dealloc( jpi,jpj, zarea )357 CALL wrk_dealloc( jpi,jpj,1, z0opw )358 CALL wrk_dealloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi )359 CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei )360 346 361 347 END SELECT … … 525 511 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' ) 526 512 ! 527 CALL wrk_dealloc( jpi,jpj, zatold, zeiold, zesold, zsmvold )528 CALL wrk_dealloc( jpi,jpj,jpl, zhimax, zviold, zvsold )529 CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab)530 513 ! 531 514 IF( nn_timing == 1 ) CALL timing_stop('limtrp') -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r7813 r7910 43 43 USE in_out_manager ! I/O manager 44 44 USE lib_mpp ! MPP library 45 USE wrk_nemo ! work arrays46 45 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 47 46 … … 289 288 REAL(wp) :: zfac0, zfac1, zsal 290 289 REAL(wp) :: zswi0, zswi01, zargtemp , zs_zero 291 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_slope_s, zalpha290 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_slope_s, zalpha 292 291 REAL(wp), PARAMETER :: zsi0 = 3.5_wp 293 292 REAL(wp), PARAMETER :: zsi1 = 4.5_wp 294 293 !!------------------------------------------------------------------ 295 294 296 CALL wrk_alloc( jpi, jpj, jpl, z_slope_s, zalpha )297 295 298 296 !--------------------------------------- … … 378 376 ENDIF ! nn_icesal 379 377 ! 380 CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha )381 378 ! 382 379 END SUBROUTINE lim_var_salprof … … 434 431 REAL(wp) :: zalpha, zswi0, zswi01, zs_zero ! - - 435 432 ! 436 REAL(wp), POINTER, DIMENSION(:) :: z_slope_s433 REAL(wp), DIMENSION(jpij) :: z_slope_s 437 434 REAL(wp), PARAMETER :: zsi0 = 3.5_wp 438 435 REAL(wp), PARAMETER :: zsi1 = 4.5_wp 439 436 !!--------------------------------------------------------------------- 440 437 441 CALL wrk_alloc( jpij, z_slope_s )442 438 443 439 !--------------------------------------- … … 503 499 ENDIF 504 500 ! 505 CALL wrk_dealloc( jpij, z_slope_s )506 501 ! 507 502 END SUBROUTINE lim_var_salprof1d … … 639 634 REAL(wp), DIMENSION(:), INTENT(in) :: zhti, zhts, zai ! input ice/snow variables 640 635 REAL(wp), DIMENSION(:,:), INTENT(inout) :: zht_i, zht_s, za_i ! output ice/snow variables 641 INTEGER , POINTER, DIMENSION(:) :: itest636 INTEGER , DIMENSION(4) :: itest 642 637 643 CALL wrk_alloc( 4, itest )644 638 !-------------------------------------------------------------------- 645 639 ! initialisation of variables … … 765 759 ENDDO 766 760 767 CALL wrk_dealloc( 4, itest )768 761 ! 769 762 END SUBROUTINE lim_var_itd -
branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r7753 r7910 22 22 USE lbclnk 23 23 USE lib_mpp ! MPP library 24 USE wrk_nemo ! work arrays25 24 USE iom 26 25 USE timing ! Timing … … 56 55 REAL(wp) :: z1_365 57 56 REAL(wp) :: z2da, z2db, ztmp 58 REAL(wp), POINTER, DIMENSION(:,:,:) :: zswi259 REAL(wp), POINTER, DIMENSION(:,:) :: z2d, zswi ! 2D workspace57 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zswi2 58 REAL(wp), DIMENSION(jpi,jpj) :: z2d, zswi ! 2D workspace 60 59 !!------------------------------------------------------------------- 61 60 62 61 IF( nn_timing == 1 ) CALL timing_start('limwri') 63 62 64 CALL wrk_alloc( jpi,jpj,jpl, zswi2 )65 CALL wrk_alloc( jpi,jpj , z2d, zswi )66 63 67 64 !----------------------------- … … 229 226 ! not yet implemented 230 227 231 CALL wrk_dealloc( jpi, jpj, jpl, zswi2 )232 CALL wrk_dealloc( jpi, jpj , z2d, zswi )233 228 234 229 IF( nn_timing == 1 ) CALL timing_stop('limwri')
Note: See TracChangeset
for help on using the changeset viewer.
