Changeset 3294 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r2777 r3294 26 26 USE lbclnk ! lateral boundary condition - MPP exchanges 27 27 USE lib_mpp ! MPP library 28 USE wrk_nemo ! 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
Note: See TracChangeset
for help on using the changeset viewer.
