#if (defined (INT8) || defined (ALL8)) #define NB_INTW 8 #else #define NB_INTW 4 #endif #if (defined (REA8) || defined (ALL8)) #define NB_REAW 8 #else #define NB_REAW 4 #endif #if (defined (DBL16) || defined (CRAY)) #define NB_DBLW 16 #else #define NB_DBLW 8 #endif c----------------------------------------------------- subroutine mem_alloc (p_tr, msize, key, object) c----------------------------------------------------- character*(*) object common /all_loc/ memory_used character*1 bte(1) integer int(1) real flt(1), tr(1) double precision dbl(1) pointer (p_tr, tr), (p_flt, flt), (p_int, int), * (p_bte, bte), (p_dbl, dbl) if (p_tr .ne. 0) then write (6, *) 'mem_alloc: non-nil pointer <',object ,'>...Stop!' stop endif if (msize .le. 0) then print*,'mem_alloc: Wrong allocation request...Stop!', key, object call perror1('mem_alloc: Wrong allocation request...Stop!',1) endif if (key .eq. 0) then !! 1-byte allocation mem_request = msize else if (key .eq. 1) then !! INTEGER allocation mem_request = msize * NB_INTW else if (key .eq. 2) then !! REAL allocation mem_request = msize * NB_REAW else if (key .eq. 3) then !! DOUBLE allocation mem_request = msize * NB_DBLW endif p_tr = malloc(mem_request) if (p_tr .eq. 0) then write (6, *) 'mem_alloc: Out of memory for <', object, '> !!!' stop endif if (key .eq. 0) then !! 1-byte allocation p_bte = p_tr do i = 1, msize bte(i) = char(0) enddo else if (key .eq. 1) then !! INTEGER allocation p_int = p_tr do i = 1, msize int(i) = 0 enddo else if (key .eq. 2) then !! REAL allocation p_flt = p_tr c x = sqrt(-1.) do i = 1, msize flt(i) = 0. c flt(i) = x enddo else if (key .eq. 3) then !! DOUBLE allocation p_dbl = p_tr do i = 1, msize dbl(i) = 0d0 enddo endif memory_used = memory_used + mem_request c write(91,*)object,p_tr,msize,mem_request,memory_used return end c----------------------------------------------------- subroutine mem_alloc_NAN (p_tr, msize, key, object) c----------------------------------------------------- character*(*) object common /all_loc/ memory_used character*1 bte(1) integer int(1) real flt(1), tr(1), rNaN double precision dbl(1) pointer (p_tr, tr), (p_flt, flt), (p_int, int), * (p_bte, bte), (p_dbl, dbl) rNaN = sqrt(-1.) if (p_tr .ne. 0) then write (6, *) 'mem_alloc: non-nil pointer <',object ,'>...Stop!' stop endif if (msize .le. 0) then print*,'mem_alloc: Wrong allocation request...Stop!', key, object call perror1('mem_alloc: Wrong allocation request...Stop!',1) endif if (key .eq. 0) then !! 1-byte allocation mem_request = msize else if (key .eq. 1) then !! INTEGER allocation mem_request = msize * NB_INTW else if (key .eq. 2) then !! REAL allocation mem_request = msize * NB_REAW else if (key .eq. 3) then !! DOUBLE allocation mem_request = msize * NB_DBLW endif p_tr = malloc(mem_request) if (p_tr .eq. 0) then write (6, *) 'mem_alloc: Out of memory for <', object, '> !!!' stop endif if (key .eq. 0) then !! 1-byte allocation p_bte = p_tr do i = 1, msize bte(i) = char(0) enddo else if (key .eq. 1) then !! INTEGER allocation p_int = p_tr do i = 1, msize int(i) = 0 enddo else if (key .eq. 2) then !! REAL allocation p_flt = p_tr do i = 1, msize flt(i) = rNaN enddo else if (key .eq. 3) then !! DOUBLE allocation p_dbl = p_tr do i = 1, msize dbl(i) = 0d0 enddo endif memory_used = memory_used + mem_request c write(91,*)object,p_tr,msize,mem_request,memory_used return end c------------------------------------------- subroutine mem_free (p_tr, msize, key) c------------------------------------------- pointer (p_tr, tr) common /all_loc/ memory_used if (p_tr .eq. 0) then write (6, *) 'mem_free: Invalid pointer...Stop!' stop endif call free(p_tr) if (key .eq. 0) then !! 1-byte allocation mem_request = msize else if (key .eq. 1) then !! INTERGER allocation mem_request = msize * NB_INTW else if (key .eq. 2) then !! REAL allocation mem_request = msize * NB_REAW else if (key .eq. 3) then !! DOUBLE allocation mem_request = msize * NB_DBLW endif memory_used = memory_used - mem_request p_tr = 0 c write(91,*)'mem_free',p_tr,msize,mem_request,memory_used return end c----------------------------------------------------------- subroutine mem_realloc (p_old, mold, mnew, mcopy, key) c----------------------------------------------------------- common /all_loc/ memory_used byte b1(1), b2(1) integer i1(1), i2(1) real f1(1), f2(1) double precision d1(1), d2(1) pointer (p_b1, b1), (p_i1, i1), (p_f1, f1), (p_d1, d1), * (p_b2, b2), (p_i2, i2), (p_f2, f2), (p_d2, d2), * (p_new, new), (p_old, old) mmin = min(mold, mnew) if (mmin .le. 0) * call perror1('mem_realloc: Wrong rallocation request...Stop!',1) if (key .eq. 0) then !! 1-byte allocation mem_request_new = mnew mem_request_old = mold else if (key .eq. 1) then !! INTERGER allocation mem_request_new = mnew * NB_INTW mem_request_old = mold * NB_INTW else if (key .eq. 2) then !! REAL allocation mem_request_new = mnew * NB_REAW mem_request_old = mold * NB_REAW else if (key .eq. 3) then !! DOUBLE allocation mem_request_new = mnew * NB_DBLW mem_request_old = mold * NB_DBLW endif p_new = malloc(mem_request_new) mmin = min(mmin, mcopy) if (key .eq. 0) then !! 1-byte allocation p_b1 = p_new p_b2 = p_old do i = 1, mmin b1(i) = b2(i) enddo else if (key .eq. 1) then !! INTERGER allocation p_i1 = p_new p_i2 = p_old do i = 1, mmin i1(i) = i2(i) enddo else if (key .eq. 2) then !! REAL allocation p_f1 = p_new p_f2 = p_old do i = 1, mmin f1(i) = f2(i) enddo else if (key .eq. 3) then !! DOUBLE allocation p_d1 = p_new p_d2 = p_old do i = 1, mmin d1(i) = d2(i) enddo endif call free(p_old) p_old = p_new memory_used = memory_used + mem_request_new - mem_request_old c write(91,*)'mem_realloc',p_new,mem_request_new,mem_request_old,memory_used return end c--------------------------------------------------- function mem_get () c--------------------------------------------------- common /all_loc/ memory_used mem_get = memory_used return end c------------------------------------------------- subroutine model_memory (nx, ny, nz, npt) c------------------------------------------------- include 'comm_new.h' include 'comm_data.h' include 'comm_pbl.h' include 'comm_diff.h' include 'comm_nao.h' include 'comm_bio.h' include 'comm_tracer.h' nptz = npt * nz nxy = nx*ny nptzp = npt * (nz+1) mptz = npt * max(4,nz) call mem_alloc (p_extra, mptz, 2, 'extra') call mem_alloc (p_extraw, mptz, 2, 'extraw') call mem_alloc (p_extram, mptz, 2, 'extram') call mem_alloc (p_u, mptz, 2, 'u') call mem_alloc (p_uc, nptz, 2, 'uc') call mem_alloc (p_fu, nptz, 2, 'fu') call mem_alloc (p_um, nptz, 2, 'um') call mem_alloc (p_v, mptz, 2, 'v') call mem_alloc (p_vc, nptz, 2, 'vc') call mem_alloc (p_fv, nptz, 2, 'fv') call mem_alloc (p_vm, nptz, 2, 'vm') call mem_alloc (p_vcm, nptz, 2, 'vcm') call mem_alloc_NAN (p_w, nptz, 2, 'w') call mem_alloc (p_wm, nptz, 2, 'wm') call mem_alloc (p_hc_top,nptz, 2, 'hc_top') call mem_alloc (p_uc_top,nptz, 2, 'uc_top') call mem_alloc (p_vc_top,nptz, 2, 'vc_top') call mem_alloc (p_sc_top,nptz, 2, 'sc_top') call mem_alloc (p_dh_top,nptz, 2, 'dh_top') call mem_alloc (p_h, nptz, 2, 'h') call mem_alloc (p_fh, nptz, 2, 'fh') call mem_alloc (p_fhd, nptz, 2, 'fhd') call mem_alloc (p_dfhd, nptz, 2, 'dfhd') call mem_alloc (p_hm, nptz, 2, 'hm') call mem_alloc (p_saxmk, nptz, 2, 'saxmk') call mem_alloc (p_saxpk, nptz, 2, 'saxpk') call mem_alloc (p_saymk, nptz, 2, 'saymk') call mem_alloc (p_saypk, nptz, 2, 'saypk') call mem_alloc (p_sxp, nptz, 2, 'sxp') call mem_alloc (p_syp, nptz, 2, 'syp') call mem_alloc (p_y_deg, npt, 2, 'y_deg') call mem_alloc (p_pgfx, nptz, 2, 'pgf_x') call mem_alloc (p_pgfy, nptz, 2, 'pgf_y') call mem_alloc (p_corx, nptz, 2, 'cor_x') call mem_alloc (p_cory, nptz, 2, 'cor_y') call mem_alloc (p_t, nptz, 2, 'tem') call mem_alloc (p_t_old, nptz, 2, 'tem_old') call mem_alloc (p_ft, nptz, 2, 'ftem') call mem_alloc (p_tp, mptz, 2, 'tp') call mem_alloc (p_tm, nptz, 2, 'tm') call mem_alloc (p_dpres, npt, 3, 'dpres') call mem_alloc (p_ddens, npt, 3, 'ddens') call mem_alloc (p_convn, nptz, 2, 'convn') call mem_alloc (p_convnm, nptz, 2, 'convnm') call mem_alloc (p_dens, nptz, 2, 'dens') call mem_alloc (p_pdens, nptz, 2, 'pdens') call mem_alloc (p_densm, nptz, 2, 'densm') call mem_alloc (p_dclim, nptz, 2, 'dclim') call mem_alloc (p_hclim, 2*nptz, 2, 'hclim') call mem_alloc (p_tclim, 2*nptz, 2, 'tclim') if (ntrac_tot.gt.0) call mem_alloc (p_trclim,nptz*ntrac_tot,2,'trclim') call mem_alloc (p_hflx_mean, npt, 2, 'hflx_mean') call mem_alloc (p_plat_mean, npt, 2, 'plat_mean') call mem_alloc (p_defi_mean, npt, 2, 'defi_mean') call mem_alloc (p_plon_mean, npt, 2, 'plon_mean') call mem_alloc (p_sens_mean, npt, 2, 'sens_mean') call mem_alloc (p_sal, nptz, 2, 'sal') call mem_alloc (p_sal_old, nptz, 2, 'sal_old') call mem_alloc (p_fsal, nptz, 2, 'fsal') call mem_alloc (p_salm, nptz, 2, 'salm') call mem_alloc (p_sss, 3*npt, 2, 'sss') call mem_alloc (p_ep, npt, 2, 'ep') call mem_alloc (p_sclim, 2*nptz, 2, 'sclim') call mem_alloc (p_sflx_mean, npt, 2, 'sflx_mean') c for bookkeeping, we introduce the following arrays: c c dynamic potential temperature fluxes c ft_ha - horizontal advective flux c ft_va - vertical advective flux c ft_ha - horizontal diffusive flux c ft_va - vertical diffusive flux c ft_ca - convective adjustment flux c ft_sp - flux through the sponge c dynamic salinity fluxes c fsal_ha - horizontal advective flux c fsal_va - vertical advective flux c fsal_ha - horizontal diffusive flux c fsal_va - vertical diffusive flux c fsal_ca - convective adjustment flux c fsal_sp - flux through the sponge c fsal_ri - river/marginal sea flux c dynamic tracer fluxes c ftr_ha - horizontal advective flux c ftr_va - vertical advective flux c ftr_ha - horizontal diffusive flux c ftr_va - vertical diffusive flux c ftr_ca - convective adjustment flux c ftr_sp - flux through the sponge call mem_alloc (p_ft_ha, nptz, 2, 'ft_ha') call mem_alloc (p_ft_va, nptz, 2, 'ft_va') call mem_alloc (p_ft_hd, nptz, 2, 'ft_hd') call mem_alloc (p_ft_vd, nptz, 2, 'ft_vd') call mem_alloc (p_ft_ca, nptz, 2, 'ft_ca') call mem_alloc (p_ft_sp, nptz, 2, 'ft_sp') call mem_alloc (p_fsal_ha, nptz, 2, 'fsal_ha') call mem_alloc (p_fsal_va, nptz, 2, 'fsal_va') call mem_alloc (p_fsal_hd, nptz, 2, 'fsal_hd') call mem_alloc (p_fsal_vd, nptz, 2, 'fsal_vd') call mem_alloc (p_fsal_ca, nptz, 2, 'fsal_ca') call mem_alloc (p_fsal_sp, nptz, 2, 'fsal_sp') call mem_alloc (p_fsal_ri, nptz, 2, 'fsal_ri') c extra arrays for kpp mixing call mem_alloc (p_sourct, nptz*2,2,'sourct') call mem_alloc (p_vvc, nptz, 2,'vvc') call mem_alloc (p_vdc, 2*nptz, 2,'vdc') call mem_alloc (p_hblt, npt, 2,'hblt') if (ntrac_tot.ne.0) * call mem_alloc (p_trflx, ntrac_tot*npt, 2,'trflx') if (use_trac.or.use_bio) then call mem_alloc (p_sourctr, nptz*ntrac_tot,2,'sourctr') call mem_alloc (p_ftr_ha, nptzp*(ntrac_tot), 2, 'ftr_ha') call mem_alloc (p_ftr_va, nptzp*(ntrac_tot), 2, 'ftr_va') call mem_alloc (p_ftr_hd, nptzp*(ntrac_tot), 2, 'ftr_hd') call mem_alloc (p_ftr_vd, nptzp*(ntrac_tot), 2, 'ftr_vd') call mem_alloc (p_ftr_ca, nptzp*(ntrac_tot), 2, 'ftr_ca') call mem_alloc (p_ftr_sp, nptzp*(ntrac_tot), 2, 'ftr_sp') call mem_alloc (p_tr, nptz*(ntrac_tot), 2, 'tr') call mem_alloc (p_tr_old, nptz*(ntrac_tot), 2, 'tr_old') call mem_alloc (p_trm, nptzp*(ntrac_tot), 2, 'trm') call mem_alloc (p_ftr, nptz*(ntrac_tot), 2, 'ftr') if (use_bio) then call mem_alloc (p_flxbio, nptzp*nflbio, 2, 'flxbio') call mem_alloc (p_xpar, nptz, 2, 'xpar') call mem_alloc (p_xle, nptz, 2, 'xle') call mem_alloc (p_xlt, nptz, 2, 'xlt') call mem_alloc (p_xln,nptz, 2, 'xln') call mem_alloc (p_xparm, nptz, 2, 'xparm') call mem_alloc (p_xlem, nptz, 2, 'xlem') call mem_alloc (p_xltm, nptz, 2, 'xltm') call mem_alloc (p_xlnm,nptz, 2, 'xlnm') call mem_alloc (p_fpar,nptz, 2, 'fpar') call mem_alloc (p_dayl,npt, 2, 'dayl') call mem_alloc (p_xzm, npt, 2, 'xzm') call mem_alloc (p_xzmm, npt, 2, 'xzmm') call mem_alloc (p_xze, npt, 2, 'xze') call mem_alloc (p_xzem, npt, 2, 'xzem') if (use_bio_old) then call mem_alloc (p_xparze, npt, 2, 'xparze') call mem_alloc (p_xparzm, npt, 2, 'xparzm') call mem_alloc (p_xlm, nptz, 2, 'xlm') call mem_alloc (p_xlmm, nptz, 2, 'xlmm') call mem_alloc (p_zparr, nptz, 2, 'zparr') call mem_alloc (p_zparg, nptz, 2, 'zparg') call mem_alloc (p_zpar100, npt, 2, 'zpar100') endif call mem_alloc1 (p_kbio, npt,'kbio') endif endif call mem_alloc (p_area, nptz, 2, 'area') c 2D--------------------------------------------- if (icl_psi.gt.0) then call mem_alloc (p_pclim, 2*npt, 2, 'pclim') endif call mem_alloc (p_sponge, npt, 2, 'sponge') call mem_alloc (p_relax, npt, 2, 'relax') call mem_alloc (p_f, npt, 2, 'f') call mem_alloc (p_emx, npt, 2, 'emx') call mem_alloc (p_emy, npt, 2, 'emy') call mem_alloc (p_emx2, npt, 2, 'emx2') call mem_alloc (p_emy2, npt, 2, 'emy2') call mem_alloc (p_cosl, npt, 2, 'cosl') call mem_alloc (p_cosli, npt, 2, 'cosli') call mem_alloc (p_dx2i, (nx+2)*ny, 2, 'dx2i') call mem_alloc (p_dy2i, nxy, 2, 'dy2i') call mem_alloc (p_ycos, ny+2, 2, 'ycos') call mem_alloc (p_taux, npt, 2, 'taux') call mem_alloc (p_tauy, npt, 2, 'tauy') call mem_alloc (p_q, npt, 2, 'q') call mem_alloc (p_qr, npt, 2, 'qr') call mem_alloc (p_qsr, npt, 2, 'qsr') call mem_alloc (p_qb, 5*npt, 2, 'qb') call mem_alloc (p_wnd, 3*npt, 2, 'wnd') call mem_alloc (p_sst, 3*npt, 2, 'sst') call mem_alloc (p_cld, 3*npt, 2, 'cld') call mem_alloc (p_solr, 3*npt, 2, 'solr') call mem_alloc (p_prcp, 3*npt, 2, 'prcp') call mem_alloc (p_dtx, 2*npt, 2, 'dtx') call mem_alloc (p_dty, 2*npt, 2, 'dty') call mem_alloc (p_dept, npt, 2, 'dept') call mem_alloc (p_ubar, npt, 2, 'ubar') call mem_alloc (p_vbar, npt, 2, 'vbar') call mem_alloc (p_uforc, npt, 2, 'uforc') call mem_alloc (p_vforc, npt, 2, 'vforc') call mem_alloc (p_psi, npt, 2, 'psi') call mem_alloc (p_psin, (nx+2)*(ny+2), 2, 'psin') call mem_alloc (p_rhs, npt, 2, 'rhs') call mem_alloc (p_psim, npt, 2, 'psim') call mem_alloc (p_cor, 2*npt, 2, 'cor') call mem_alloc (p_pgf, 2*npt, 2, 'pgf') call mem_alloc (p_tfu, npt, 2, 'tfu') call mem_alloc (p_tfv, npt, 2, 'tfv') call mem_alloc (p_gradH, 2*npt, 2, 'gradH') call mem_alloc (p_gradE, 2*npt, 2, 'gradE') call mem_alloc (p_zmld, npt, 2, 'zmld') call mem_alloc (p_xmld, npt, 2, 'xmld') call mem_alloc (p_xm, nx, 2, 'x') call mem_alloc (p_ym, ny, 2, 'y') call mem_alloc (p_xp, nx, 2, 'xp') call mem_alloc (p_yp, ny, 2, 'yp') call mem_alloc (p_hsave, nz+1, 2, 'hsave') call mem_alloc1 (p_isk, npt*nz, 'isk') call mem_alloc1 (p_iyk, npt*nz, 'iyk') call mem_alloc1 (p_isxk, npt*nz, 'isxk') call mem_alloc1 (p_isyk, npt*nz, 'isyk') call mem_alloc1 (p_nzi, npt, 'nzi') call mem_alloc1 (p_nzibx, npt, 'nzibx') call mem_alloc1 (p_nziby, npt, 'nziby') call mem_alloc (p_taux_anom, 2*npt, 2, 'taux_anom') call mem_alloc (p_tauy_anom, 2*npt, 2, 'tauy_anom') if (use_nao) then c we are allocating 2*npt for + and - NAO patterns c oh well, fix these later ... call mem_alloc (p_wnsp_anom, npt, 2, 'wnsp_anom') call mem_alloc (p_uwnd_anom, npt, 2, 'uwnd_anom') call mem_alloc (p_vwnd_anom, npt, 2, 'vwnd_anom') call mem_alloc (p_ahum_anom, nxy, 2, 'ahum_anom') call mem_alloc (p_atem_anom, nxy, 2, 'atem_anom') call mem_alloc (p_prp_anom , npt, 2, 'prp_anom') endif if (use_wnsp) then call mem_alloc2 (p_wnsp, npt, 2, 'wnsp') endif if (initq .eq. 8 .or. use_ice) then call mem_alloc2 (p_uwnd, npt, 2, 'uwnd') call mem_alloc2 (p_vwnd, npt, 2, 'vwnd') call mem_alloc2 (p_ahum, nxy, 3, 'ahum') call mem_alloc2 (p_atem, nxy, 3, 'atem') call mem_alloc (p_amhum, nxy, 2, 'amhum') call mem_alloc (p_amth, nxy, 2, 'amth') call mem_alloc (p_amhum_mean, nxy, 2, 'amhum_mean') call mem_alloc (p_amth_mean, nxy, 2, 'amth_mean') endif if (use_ice) then call mem_alloc (p_trs, npt*(ntrac_sur), 2, 'trs') call mem_alloc (p_trsm, npt*(ntrac_sur), 2, 'trsm') call mem_alloc (p_rh, nxy, 2, 'rh') call mem_alloc (p_pp, npt, 2, 'pp') call mem_alloc (p_qios, npt, 2, 'qios') call mem_alloc (p_brne, npt, 2, 'brne') call mem_alloc (p_tsnw, nxy, 2, 'tsnw') call mem_alloc (p_rlhi, nxy, 2, 'rlhi') call mem_alloc (p_shi, nxy, 2, 'shi') call mem_alloc (p_qlwi, nxy, 2, 'qlwi') call mem_alloc (p_qswi, nxy, 2, 'qswi') if (use_dyice) then nxyi = (nx+2)*(ny+2) nxyb = (nx+3)*(ny+3) call mem_alloc (p_uice, nxyb, 2, 'uice') call mem_alloc (p_vice, nxyb, 2, 'vice') call mem_alloc (p_pice, nxyi, 2, 'pice') call mem_alloc (p_etaC, nxyi, 2, 'etaC') call mem_alloc (p_etaB, nxyb, 2, 'etaB') call mem_alloc (p_tauwx, npt, 2, 'tauwx') call mem_alloc (p_tauwy, npt, 2, 'tauwy') elseif (use_dyice_old) then call mem_alloc (p_fcice, npt, 2, 'fcice') call mem_alloc (p_fhice, npt, 2, 'fhice') call mem_alloc (p_fthice, npt, 2, 'fthice') endif endif c if (use_diffiso) then call mem_alloc2 (p_gtrz,npt,nz, 'gtrz') call mem_alloc2 (p_slx, npt,nz, 'slx') call mem_alloc2 (p_sly, npt,nz, 'sly') call mem_alloc2 (p_trx, npt,nz, 'trx') call mem_alloc2 (p_try, npt,nz, 'try') call mem_alloc2 (p_trz, npt,nz, 'trz') call mem_alloc2 (p_sigx,npt,nz, 'sigx') call mem_alloc2 (p_sigy,npt,nz, 'sigy') call mem_alloc2 (p_sigz,npt,nz, 'sigz') call mem_alloc (p_gtr, npt, 2, 'gtr1') call mem_alloc (p_Kmap, npt, 2, 'Kmap') call mem_alloc (p_Kaspect, npt, 2, 'Kaspect') c endif call mem_alloc (p_sxm, nptz, 2, 'sxm') call mem_alloc (p_sym, nptz, 2, 'sym') call mem_alloc (p_dxp, npt, 2, 'dxp') call mem_alloc (p_dyp, npt, 2, 'dyp') call mem_alloc (p_csy, npt, 2, 'csy') call mem_alloc (p_csyc, npt, 2, 'csyc') call mem_alloc (p_vcint, nz*ny, 2, 'zonally integrated vc') call mem_alloc (p_psiv, (nz+2)*ny, 2, 'meridional sf') call mem_alloc (p_q_ha, ny, 2, 'meridional q_ha') call mem_alloc (p_q_hd, ny, 2, 'meridional q_hd') call mem_alloc (p_q_sp, ny, 2, 'meridional q_sp') call mem_alloc (p_ep_ha, ny, 2, 'meridional ep_ha') call mem_alloc (p_ep_hd, ny, 2, 'meridional ep_hd') call mem_alloc (p_ep_sp, ny, 2, 'meridional ep_sp') call mem_alloc (p_ep_ri, ny, 2, 'meridional ep_ri') call mem_alloc (p_hflx_y,ny, 2, 'meridional hflx_y') call mem_alloc (p_sflx_y,ny, 2, 'meridional sflx_y') return end c-------------------------------------- subroutine datagrid_memory (tmp) c-------------------------------------- dimension tmp(1) include 'comm_new.h' include 'comm_data.h' call mem_alloc (p_xd, mxp, 2, 'xd') do i = 1, mxp xd(i) = tmp(i) enddo call mem_alloc (p_yd, myp, 2, 'yd') do i = 1, myp yd(i) = tmp(mxp+i) enddo c.....shift SEGMENTS array to begining of tmp do i = 1, mseg tmp(i) = tmp(mxp+myp+i) enddo call mem_alloc1 (p_ixd, mxp*myp, 'ixd') call mem_alloc1 (p_im2d, npt2, 'im2d') call mem_alloc (p_blcf, 4*npt2, 2, 'blcf') call mem_alloc (p_tpdata, mxp*myp, 2, 'data_tmp') idatgr = 1 return end c----------------------------------------------------- subroutine mem_alloc2 (p_tr, nx, ny, object) c----------------------------------------------------- character*(*) object common /all_loc/ memory_used real flt(nx,1), tr(nx,1) pointer (p_tr, tr), (p_flt, flt) msize = nx*ny if (p_tr .ne. 0) then write (6, *) 'mem_alloc: non-nil pointer <',object ,'>...Stop!' stop endif if (msize .le. 0) then print*,'mem_alloc: Wrong allocation request...Stop!', key, object call perror1('mem_alloc: Wrong allocation request...Stop!',1) endif mem_request = msize * NB_REAW p_tr = malloc(mem_request) if (p_tr .eq. 0) then write (6, *) 'mem_alloc: Out of memory for <', object, '> !!!' stop endif p_flt = p_tr do i = 1, nx do j = 1, ny flt(i,j) = 0. enddo enddo memory_used = memory_used + mem_request c write(91,*)object,p_tr,msize,mem_request,memory_used return end c----------------------------------------------------- subroutine mem_alloc1 (p_tr, msize, object) c----------------------------------------------------- character*(*) object common /all_loc/ memory_used integer int(1), tr(1) pointer (p_tr, tr), (p_int, int) if (p_tr .ne. 0) then write (6, *) 'mem_alloc1: non-nil pointer <',object ,'>...Stop!' stop endif if (msize .le. 0) then print*,'mem_alloc1: Wrong allocation request...Stop!', key, object call perror1('mem_alloc1: Wrong allocation request...Stop!',1) endif mem_request = msize * NB_INTW p_tr = malloc(mem_request) if (p_tr .eq. 0) then write (6, *) 'mem_alloc1: Out of memory for <', object, '> !!!' stop endif p_int = p_tr do i = 1, msize int(i) = 0 enddo memory_used = memory_used + mem_request c write(91,*)object,p_tr,msize,mem_request,memory_used return end c----------------------------------------------------- subroutine mem_alloc0 (p_tr, msize, object) c----------------------------------------------------- character*(*) object common /all_loc/ memory_used character*1 bte(1), tr(1) pointer (p_tr, tr), (p_bte, bte) if (p_tr .ne. 0) then write (6, *) 'mem_alloc0: non-nil pointer <',object ,'>...Stop!' stop endif if (msize .le. 0) then print*,'mem_alloc0: Wrong allocation request...Stop!', key, object call perror1('mem_alloc: Wrong allocation request...Stop!',1) endif mem_request = msize p_tr = malloc(mem_request) if (p_tr .eq. 0) then write (6, *) 'mem_alloc0: Out of memory for <', object, '> !!!' stop endif p_bte = p_tr do i = 1, msize bte(i) = char(0) enddo memory_used = memory_used + mem_request c write(91,*)object,p_tr,msize,mem_request,memory_used return end