- Timestamp:
- 2017-04-13T16:21:08+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.