!``````````````````````````````````````````````````````````````````` module vtables_mod !+ Module that contains grid-dependent variable indices implicit none integer, parameter :: THP_vidx = 9, TKEP_vidx = 11, RV_vidx = 30 ! Change these dimensions if "unknown" (not yet assigned a variable ! number) variables change: integer, parameter :: unvar_nbnd = 8, & ! Max # of varidx boundaries unvar_ntype = 7 ! Max # of unvar types integer, allocatable, dimension(:,:) :: unvar_bndidx ! unknown varidx integer, allocatable, dimension(:,:) :: fi_idx, ff_idx, aj_idx, & ag_idx, rs_idx ! {n_vars,n_grids} !*** Grid DEPENDENT variable index tables: integer, allocatable, dimension(:) :: nv3d, & ! Number of variables nv2d, nv3ds, nv2ds, nv3dm, n_state_3D, n_state_2D, n_state_3Ds, & n_state_2Ds, n_state_3Dm, nsclr, naersclr ! {n_grids} integer, allocatable, dimension(:,:) :: & ! {n_vars,n_grids} ivtab3d, ivtab2d, ivtab3ds, ivtab2ds, ivtab3dm, i_state_tab3D, & i_state_tab2D, i_state_tab3Ds, i_state_tab2Ds, i_state_tab3Dm, isclrp, & isclrt, iaersclp, iaersclt, iaersfi, iaersff, iaersaj, iaersag, iaersrs integer, parameter :: ivopt_clen = 8 character(len=ivopt_clen), allocatable, dimension(:,:) :: ivopt3d, & ivopt2d, ivopt3ds, ivopt2ds, ivopt3dm ! {n_vars,n_grids} character(len=ivopt_clen), allocatable, dimension(:) :: & ! {n_vars} ivopt3m !*** Grid INDEPENDENT variable index tables: integer :: nv3dmt ! Number of variables integer, allocatable, dimension(:) :: ivtab3m ! {n_vars} !*** Parallel variable index tables, etc.: integer, allocatable, dimension(:) :: nmp31, nmp32, & ! {n_grids} nmp33, nmp3i, nmp21, nmp22, nmp23, nmp2i, nmps31, nmps21, nmps32, & nmps22, nmps33, nmps23, nmps3i, nmps2i integer, allocatable, dimension(:,:) :: mp3tab1, & ! {n_vars,n_grids} mp3tab2, mp3tab3, mp3tabi, mp2tab1, mp2tab2, mp2tab3, mp2tabi, mp3stab1, & mp2stab1, mp3stab2, mp2stab2, mp3stab3, mp2stab3, mp3stabi, mp2stabi !*** Variable table name string arrays: integer, parameter :: ivnstr_clen = 8 character(len=ivnstr_clen), allocatable, dimension(:,:) :: mp3chr1, & mp3chr2, mp3chr3, mp3chri, mp2chr1, mp2chr2, mp2chr3, & ! {n_vars,n_grids} mp2chri, mp3schr1, mp2schr1, mp3schr2, mp2schr2, mp3schr3, mp2schr3, & mp3schri, mp2schri, ivchr3d, ivchr2d, ivchr3ds, ivchr2ds, ivchr3dm, & i_state_chr3D, i_state_chr2D, i_state_chr3Ds, i_state_chr2Ds, & i_state_chr3Dm, ischrp, ischrt, iaerschrp, iaerschrt, iaerschrfi, & iaerschrff, iaerschraj, iaerschrag, iaerschrrs !############################################################################# !*** 3D "normal" variable index arrays {n_grids}: marker3n integer, allocatable, dimension(:) :: iupn, iucn, ivpn, ivcn, iwpn, & iwcn, ippn, ipcn, ithpn, ihkmn, irvn, ithetan, itkepn, ifthrdn, ivarupn, & ivarvpn, ivartpn, ivarrpn, ivarufn, ivarvfn, ivartfn, ivarrfn, ivarwtsn, & ipi0n, idn0n, ith0n, ivkmn, ivkhn, idn0un, idn0vn integer :: iup, iuc, ivp, ivc, iwp, iwc, ipp, ipc, ithp, ihkm, irv, & itheta, itkep, ifthrd, ivarup, ivarvp, ivartp, ivarrp, ivaruf, ivarvf, & ivartf, ivarrf, ivarwts, ipi0, idn0, ith0, ivkm, ivkh, idn0u, idn0v integer, allocatable, dimension(:,:) :: isclpn ! {n_grids,naddsc} integer, allocatable, dimension(:) :: isclp ! {naddsc} integer :: iscp integer, allocatable, dimension(:,:) :: idustncn ! {n_grids,dust_nb} integer, allocatable, dimension(:) :: idustnc ! {dust_nb} integer, allocatable, dimension(:,:) :: iCO2incn, iCO2dcrn, & iCO2wcrn ! {n_grids,CO2i_nb} integer, allocatable, dimension(:) :: iCO2inc, iCO2dcr, & iCO2wcr ! {CO2i_nb} integer, allocatable, dimension(:,:) :: iH2Oincn, & iH2Odcrn ! {n_grids,H2Oi_nb} integer, allocatable, dimension(:) :: iH2Oinc, iH2Odcr ! {H2Oi_nb} integer :: iaerscp, iaersct, iaerfi, iaerff, iaeraj, iaerag, iaerrs !*** 3D grid-independent variable indices: marker3m integer :: iut, ivt, iwt, ipt, itht, irvt, itket, ivt3da, ivt3db, & ivt3dc, ivt3dd, ivt3de, ivt3df, ivt3dg, ivt3dh, ivt3di, ivt3dj, ivt3dk, & ivt3dl, ivt3dm, ivt3dn, ivt3do, ivt3dp, idustcort, iCO2icort, iCO2dcort, & iCO2wcort, iH2Oicort, iH2Odcort integer, allocatable, dimension(:) :: isclt ! {naddsc} integer :: isct integer, allocatable, dimension(:) :: idustnt ! {dust_nb} integer, allocatable, dimension(:) :: iH2Oint, iH2Odct ! {H2Oi_nb} integer, allocatable, dimension(:) :: iCO2int, iCO2dct, & iCO2wct ! {CO2i_nb} !*** 2D "normal" variable index arrays [n_grids]: marker2n integer, allocatable, dimension(:) :: itoptn, itopun, itopvn, itopmn, & irtgtn, irtgun, irtgvn, irtgmn, if13tn, if13un, if13vn, if13mn, if23tn, & if23un, if23vn, if23mn, idxun, idxvn, idxtn, idxmn, idyun, idyvn, idytn, & idymn, ifmapun, ifmapvn, ifmaptn, ifmapmn, ifmapuin, ifmapvin, ifmaptin, & ifmapmin, iglatn, iglonn, iuwn, ivwn, iwfzn, itfzn, iqfzn, irshortn, & irlongn, irlongupn, ialbedtn, ivarpn, ivarp2n, ifcorun, ifcorvn, & ivt2dan, ivt2dbn, ivt2dcn, ivt2ddn, ivt2den, ivt2dfn, icoszn, itopz0n, & itslopangn, itazmangn, idustcorsn, iCO2icorsn, iCO2dcorsn, iCO2wcorsn, & iH2Oicorsn, iH2Odcorsn integer :: itopt, itopu, itopv, itopm, irtgt, irtgu, irtgv, irtgm, & if13t, if13u, if13v, if13m, if23t, if23u, if23v, if23m, idxu, idxv, & idxt, idxm, idyu, idyv, idyt, idym, ifmapu, ifmapv, ifmapt, ifmapm, & ifmapui, ifmapvi, ifmapti, ifmapmi, iglat, iglon, iuw, ivw, iwfz, itfz, & iqfz, irshort, irlong, irlongup, ialbedt, ivarp, ivarp2, ifcoru, ifcorv, & ivt2da, ivt2db, ivt2dc, ivt2dd, ivt2de, ivt2df, icosz, itopz0, & itslopang, itazmang, idustcors, iCO2icors, iCO2dcors, iCO2wcors, & iH2Oicors, iH2Odcors integer, allocatable, dimension(:,:) :: idustfin, idustffn, idustajn, & idustagn, idustrsn ! {n_grids,dust_nb} integer, allocatable, dimension(:) :: idustfi, idustff, idustaj, & idustag, idustrs ! {dust_nb} integer, allocatable, dimension(:,:) :: iH2Oifin, iH2Odfin, iH2Oiffn, & iH2Odffn, iH2Oiajn, iH2Odajn, iH2Oiagn, iH2Odagn, iH2Oirsn, & iH2Odrsn ! {n_grids,H2Oi_nb} integer, allocatable, dimension(:) :: iH2Oifi, iH2Odfi, iH2Oiff, & iH2Odff, iH2Oiaj, iH2Odaj, iH2Oiag, iH2Odag, iH2Oirs, iH2Odrs ! {H2Oi_nb} integer, allocatable, dimension(:,:) :: iCO2ifin, iCO2dfin, & iCO2wfin, iCO2iffn, iCO2dffn, iCO2wffn, iCO2iajn, iCO2dajn, iCO2wajn, & iCO2iagn, iCO2dagn, iCO2wagn, iCO2irsn, iCO2drsn, & iCO2wrsn ! {n_grids,CO2i_nb} integer, allocatable, dimension(:) :: iCO2ifi, iCO2dfi, iCO2wfi, & iCO2iff, iCO2dff, iCO2wff, iCO2iaj, iCO2daj, iCO2waj, iCO2iag, iCO2dag, & iCO2wag, iCO2irs, iCO2drs, iCO2wrs ! {CO2i_nb} !*** 3D sub/super surface variable index arrays [n_grids]: integer, allocatable, dimension(:) :: isbpsdensn, isbpstmcpn, & isbpstmcdn, isbpslthkn, isbpsqn, isbpsh2oan integer :: isbpsdens, isbpstmcp, isbpstmcd, isbpslthk, isbpsq, isbpsh2oa !*** 2D sub/super surface variable index arrays [n_grids]: integer, allocatable, dimension(:) :: ipatchfcvn, iz0statn, iz0netn, & ialbdstatn, itistatn, isfctempkn, isfch2omrn, iustarn, itstarn, irstarn integer :: ipatchfcv, iz0stat, iz0net, ialbdstat, itistat, isfctempk, & isfch2omr, iustar, itstar, irstar !*** Arrays that hold all variable index values: integer, allocatable, dimension(:,:) :: ind3dn, ind2dn, ind3dsn, & ind2dsn ! {n_grids,0:n_vars} integer, allocatable, dimension(:) :: ind3d, ind2d, ind3dm, & ind2ds, ind3ds ! {0:n_vars} !*** Nest boundary ("B") array stuff: integer, allocatable, dimension(:) :: ibux, ibuy, ibuz, & ! {n_grids} ibvx, ibvy, ibvz, ibwx, ibwy, ibwz, ibpx, ibpy, ibpz integer, allocatable, dimension(:,:) :: ibsx, ibsy, & ! {n_vars,n_grids} ibsz, ibax, ibay, ibaz contains !``````````````````````````````````````````````````````````````````` subroutine vtable_mem(on_or_off) !+ Allocates or deallocates variable table arrays use univ_IO_mem_status_mod, only: illegal_alloc_stop, for_allocation, & for_deallocation use univ_maxlen_string_mod, only: MAX_PROC_NAME_LEN use main_memory_mod, only: n_grids, naddsc, n_vars use main_memory_bspec_mod, only: dust_nb, CO2i_nb, H2Oi_nb implicit none !=== Argument declarations: logical, intent(IN) :: on_or_off !== Local declarations: character(len=MAX_PROC_NAME_LEN), parameter :: & procedure_name = 'vtable_mem' integer :: aerr, ng, nv !=== Executable statements: ng = n_grids nv = n_vars if (on_or_off) then allocate(nv3d(ng), nv2d(ng), nv3ds(ng), nv2ds(ng), nv3dm(ng), & n_state_3D(ng), n_state_2D(ng), n_state_3Ds(ng), n_state_2Ds(ng), & n_state_3Dm(ng), nsclr(ng), naersclr(ng), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem01') allocate(ivtab3d(nv,ng), ivtab2d(nv,ng), ivtab3ds(nv,ng), ivtab2ds(nv,ng), & ivtab3dm(nv,ng), i_state_tab3D(nv,ng), i_state_tab2D(nv,ng), & i_state_tab3Ds(nv,ng), i_state_tab2Ds(nv,ng), i_state_tab3Dm(nv,ng), & isclrp(nv,ng), isclrt(nv,ng), iaersclp(nv,ng), iaersclt(nv,ng), & iaersfi(nv,ng), iaersff(nv,ng), iaersaj(nv,ng), iaersag(nv,ng), & iaersrs(nv,ng), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem02') allocate(ivtab3m(nv), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem03') allocate(iupn(ng),iucn(ng),ivpn(ng),ivcn(ng),iwpn(ng),iwcn(ng),ippn(ng) & ,ipcn(ng),ithpn(ng),ihkmn(ng),irvn(ng),ithetan(ng) & ,itkepn(ng),ifthrdn(ng),ivarupn(ng),ivarvpn(ng),ivartpn(ng) & ,ivarrpn(ng),ivarufn(ng),ivarvfn(ng),ivartfn(ng),ivarrfn(ng) & ,ivarwtsn(ng),ipi0n(ng),idn0n(ng),ith0n(ng),ivkmn(ng),ivkhn(ng) & ,idn0un(ng),idn0vn(ng), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem04') if(naddsc > 0) then allocate(isclpn(ng,naddsc),isclp(naddsc), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, & procedure_name, 'vtable_mem05') endif if(dust_nb > 0) then allocate(idustncn(ng,dust_nb),idustnc(dust_nb), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, & procedure_name, 'vtable_mem05a') endif if(H2Oi_nb > 0) then allocate(iH2Oincn(ng,H2Oi_nb),iH2Oinc(H2Oi_nb),iH2Odcrn(ng,H2Oi_nb) & ,iH2Odcr(H2Oi_nb), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, & procedure_name, 'vtable_mem05b') endif if(CO2i_nb > 0) then allocate(iCO2incn(ng,CO2i_nb),iCO2inc(CO2i_nb),iCO2dcrn(ng,CO2i_nb) & ,iCO2dcr(CO2i_nb),iCO2wcrn(ng,CO2i_nb),iCO2wcr(CO2i_nb) & , stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, & procedure_name, 'vtable_mem05c') endif allocate(itoptn(ng),itopun(ng),itopvn(ng),itopmn(ng),irtgtn(ng) & ,irtgun(ng),irtgvn(ng),irtgmn(ng),if13tn(ng),if13un(ng),if13vn(ng) & ,if13mn(ng),if23tn(ng),if23un(ng),if23vn(ng),if23mn(ng),idxun(ng) & ,idxvn(ng),idxtn(ng),idxmn(ng),idyun(ng),idyvn(ng),idytn(ng) & ,idymn(ng),ifmapun(ng),ifmapvn(ng),ifmaptn(ng),ifmapmn(ng) & ,ifmapuin(ng),ifmapvin(ng),ifmaptin(ng),ifmapmin(ng),iglatn(ng) & ,iglonn(ng),iuwn(ng),ivwn(ng),iwfzn(ng),itfzn(ng),iqfzn(ng) & ,irshortn(ng),irlongn(ng),irlongupn(ng),ialbedtn(ng),ivarpn(ng) & ,ivarp2n(ng),ifcorun(ng),ifcorvn(ng),ivt2dan(ng),ivt2dbn(ng) & ,ivt2dcn(ng),ivt2ddn(ng),ivt2den(ng),ivt2dfn(ng),icoszn(ng) & ,itopz0n(ng),itslopangn(ng),itazmangn(ng), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem06') if(dust_nb > 0) then allocate(idustfin(ng,dust_nb),idustfi(dust_nb),idustffn(ng,dust_nb) & ,idustff(dust_nb),idustajn(ng,dust_nb),idustaj(dust_nb) & ,idustagn(ng,dust_nb),idustag(dust_nb),idustrsn(ng,dust_nb) & ,idustrs(dust_nb), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, & procedure_name, 'vtable_mem06a') endif if(H2Oi_nb > 0) then allocate(iH2Oifin(ng,H2Oi_nb),iH2Oifi(H2Oi_nb),iH2Oiffn(ng,H2Oi_nb) & ,iH2Oiff(H2Oi_nb),iH2Oiajn(ng,H2Oi_nb),iH2Oiaj(H2Oi_nb) & ,iH2Oiagn(ng,H2Oi_nb),iH2Oiag(H2Oi_nb),iH2Oirsn(ng,H2Oi_nb) & ,iH2Oirs(H2Oi_nb) & ,iH2Odfin(ng,H2Oi_nb),iH2Odfi(H2Oi_nb),iH2Odffn(ng,H2Oi_nb) & ,iH2Odff(H2Oi_nb),iH2Odajn(ng,H2Oi_nb),iH2Odaj(H2Oi_nb) & ,iH2Odagn(ng,H2Oi_nb),iH2Odag(H2Oi_nb),iH2Odrsn(ng,H2Oi_nb) & ,iH2Odrs(H2Oi_nb), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, & procedure_name, 'vtable_mem06b') endif if(CO2i_nb > 0) then allocate(iCO2ifin(ng,CO2i_nb),iCO2ifi(CO2i_nb),iCO2iffn(ng,CO2i_nb) & ,iCO2iff(CO2i_nb),iCO2iajn(ng,CO2i_nb),iCO2iaj(CO2i_nb) & ,iCO2iagn(ng,CO2i_nb),iCO2iag(CO2i_nb),iCO2irsn(ng,CO2i_nb) & ,iCO2irs(CO2i_nb) & ,iCO2dfin(ng,CO2i_nb),iCO2dfi(CO2i_nb),iCO2dffn(ng,CO2i_nb) & ,iCO2dff(CO2i_nb),iCO2dajn(ng,CO2i_nb),iCO2daj(CO2i_nb) & ,iCO2dagn(ng,CO2i_nb),iCO2dag(CO2i_nb),iCO2drsn(ng,CO2i_nb) & ,iCO2drs(CO2i_nb) & ,iCO2wfin(ng,CO2i_nb),iCO2wfi(CO2i_nb),iCO2wffn(ng,CO2i_nb) & ,iCO2wff(CO2i_nb),iCO2wajn(ng,CO2i_nb),iCO2waj(CO2i_nb) & ,iCO2wagn(ng,CO2i_nb),iCO2wag(CO2i_nb),iCO2wrsn(ng,CO2i_nb) & ,iCO2wrs(CO2i_nb), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, & procedure_name, 'vtable_mem06c') endif allocate(nmp31(ng),nmp32(ng),nmp33(ng),nmp3i(ng),nmp21(ng),nmp22(ng) & ,nmp23(ng),nmp2i(ng),nmps31(ng),nmps21(ng),nmps32(ng),nmps22(ng) & ,nmps33(ng),nmps23(ng),nmps3i(ng),nmps2i(ng), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem07') allocate(mp3tab1(nv,ng),mp3tab2(nv,ng),mp3tab3(nv,ng),mp3tabi(nv,ng) & ,mp2tab1(nv,ng),mp2tab2(nv,ng),mp2tab3(nv,ng),mp2tabi(nv,ng) & ,mp3stab1(nv,ng),mp2stab1(nv,ng),mp3stab2(nv,ng),mp2stab2(nv,ng) & ,mp3stab3(nv,ng),mp2stab3(nv,ng),mp3stabi(nv,ng),mp2stabi(nv,ng) & , stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem08') allocate(ivopt3d(nv,ng),ivopt2d(nv,ng),ivopt3ds(nv,ng),ivopt2ds(nv,ng) & ,ivopt3dm(nv,ng), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem09') allocate(ivopt3m(nv), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem10') allocate(mp3chr1(nv,ng),mp3chr2(nv,ng),mp3chr3(nv,ng),mp3chri(nv,ng) & ,mp2chr1(nv,ng),mp2chr2(nv,ng),mp2chr3(nv,ng),mp2chri(nv,ng) & ,mp3schr1(nv,ng),mp2schr1(nv,ng),mp3schr2(nv,ng),mp2schr2(nv,ng) & ,mp3schr3(nv,ng),mp2schr3(nv,ng),mp3schri(nv,ng),mp2schri(nv,ng) & ,ivchr3d(nv,ng),ivchr2d(nv,ng),ivchr3ds(nv,ng),ivchr2ds(nv,ng) & ,ivchr3dm(nv,ng),i_state_chr3D(nv,ng),i_state_chr2D(nv,ng), & i_state_chr3Ds(nv,ng), i_state_chr2Ds(nv,ng), i_state_chr3Dm(nv,ng), & ischrp(nv,ng), ischrt(nv,ng), iaerschrp(nv,ng), iaerschrt(nv,ng) & ,iaerschrfi(nv,ng),iaerschrff(nv,ng),iaerschraj(nv,ng) & ,iaerschrag(nv,ng),iaerschrrs(nv,ng), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem11') if(naddsc > 0) then allocate(isclt(naddsc), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem12') endif if(dust_nb > 0) then allocate(idustnt(dust_nb), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem12a') endif if(H2Oi_nb > 0) then allocate(iH2Oint(H2Oi_nb),iH2Odct(H2Oi_nb), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem12b') endif if(CO2i_nb > 0) then allocate(iCO2int(CO2i_nb),iCO2dct(CO2i_nb),iCO2wct(CO2i_nb), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem12c') endif allocate(ind3dn(ng,0:nv),ind2dn(ng,0:nv),ind3dsn(ng,0:nv) & ,ind2dsn(ng,0:nv), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem13') allocate(ind3d(0:nv),ind2d(0:nv),ind3dm(0:nv),ind2ds(0:nv),ind3ds(0:nv) & , stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem14') allocate(ibux(ng),ibuy(ng),ibuz(ng),ibvx(ng),ibvy(ng),ibvz(ng),ibwx(ng) & ,ibwy(ng),ibwz(ng),ibpx(ng),ibpy(ng),ibpz(ng), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem15') allocate(ibsx(nv,ng),ibsy(nv,ng),ibsz(nv,ng),ibax(nv,ng),ibay(nv,ng) & ,ibaz(nv,ng), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem16') allocate(isbpsdensn(ng),isbpstmcpn(ng),isbpstmcdn(ng),isbpslthkn(ng) & ,isbpsqn(ng),isbpsh2oan(ng), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem17') allocate(ipatchfcvn(ng),iz0statn(ng),iz0netn(ng),ialbdstatn(ng) & ,itistatn(ng),isfctempkn(ng),isfch2omrn(ng),iustarn(ng) & ,itstarn(ng),irstarn(ng), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem18') allocate(unvar_bndidx(unvar_nbnd,unvar_ntype),fi_idx(nv,ng) & ,ff_idx(nv,ng),aj_idx(nv,ng),ag_idx(nv,ng),rs_idx(nv,ng), stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_allocation, procedure_name, & 'vtable_mem19') else deallocate(nv3d, nv2d, nv3ds, nv3dm, n_state_3D, n_state_2D, n_state_3Ds, & n_state_2Ds, n_state_3Dm, nsclr, naersclr, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem01') deallocate(ivtab3d, ivtab2d, ivtab3ds, ivtab2ds, ivtab3dm, i_state_tab3D, & i_state_tab2D, i_state_tab3Ds, i_state_tab2Ds, i_state_tab3Dm, & isclrp, isclrt, iaersclp, iaersclt, iaersfi, iaersff, iaersaj, & iaersag, iaersrs, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem02') deallocate(ivtab3m, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem03') deallocate(iupn,iucn,ivpn,ivcn,iwpn,iwcn,ippn,ipcn,ithpn,ihkmn & ,irvn,ithetan,itkepn,ifthrdn,ivarupn,ivarvpn,ivartpn,ivarrpn & ,ivarufn,ivarvfn,ivartfn,ivarrfn,ivarwtsn,ipi0n,idn0n,ith0n,ivkmn & ,ivkhn,idn0un,idn0vn, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem04') if(naddsc > 0) then deallocate(isclpn,isclp, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, & procedure_name, 'vtable_mem05') endif if(dust_nb > 0) then deallocate(idustncn,idustnc, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, & procedure_name, 'vtable_mem05a') endif if(H2Oi_nb > 0) then deallocate(iH2Oincn,iH2Oinc,iH2Odcrn,iH2Odcr, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, & procedure_name, 'vtable_mem05b') endif if(CO2i_nb > 0) then deallocate(iCO2incn,iCO2inc,iCO2dcrn,iCO2dcr,iCO2wcrn,iCO2wcr & , stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, & procedure_name, 'vtable_mem05c') endif deallocate(itoptn,itopun,itopvn,itopmn,irtgtn,irtgun,irtgvn,irtgmn & ,if13tn,if13un,if13vn,if13mn,if23tn,if23un,if23vn,if23mn,idxun & ,idxvn,idxtn,idxmn,idyun,idyvn,idytn,idymn,ifmapun,ifmapvn,ifmaptn & ,ifmapmn,ifmapuin,ifmapvin,ifmaptin,ifmapmin,iglatn,iglonn,iuwn & ,ivwn,iwfzn,itfzn,iqfzn,irshortn,irlongn,irlongupn,ialbedtn & ,ivarpn,ivarp2n,ifcorun,ifcorvn,ivt2dan,ivt2dbn,ivt2dcn,ivt2ddn & ,ivt2den,ivt2dfn,icoszn,itopz0n,itslopangn,itazmangn, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, & procedure_name, 'vtable_mem06') if(dust_nb > 0) then deallocate(idustfin,idustfi,idustffn,idustff,idustajn,idustaj & ,idustagn,idustag,idustrsn,idustrs, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, & procedure_name, 'vtable_mem06a') endif if(H2Oi_nb > 0) then deallocate(iH2Oifin,iH2Oifi,iH2Oiffn,iH2Oiff,iH2Oiajn,iH2Oiaj & ,iH2Oiagn,iH2Oiag,iH2Oirsn,iH2Oirs,iH2Odfin,iH2Odfi,iH2Odffn & ,iH2Odff,iH2Odajn,iH2Odaj,iH2Odagn,iH2Odag,iH2Odrsn,iH2Odrs & , stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, & procedure_name, 'vtable_mem06b') endif if(CO2i_nb > 0) then deallocate(iCO2ifin,iCO2ifi,iCO2iffn,iCO2iff,iCO2iajn,iCO2iaj & ,iCO2iagn,iCO2iag,iCO2irsn,iCO2irs,iCO2dfin,iCO2dfi,iCO2dffn & ,iCO2dff,iCO2dajn,iCO2daj,iCO2dagn,iCO2dag,iCO2drsn,iCO2drs & ,iCO2wfin,iCO2wfi,iCO2wffn,iCO2wff,iCO2wajn,iCO2waj,iCO2wagn & ,iCO2wag,iCO2wrsn,iCO2wrs, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, & procedure_name, 'vtable_mem06c') endif deallocate(nmp31,nmp32,nmp33,nmp3i,nmp21,nmp22,nmp23,nmp2i,nmps31 & ,nmps21,nmps32,nmps22,nmps33,nmps23,nmps3i,nmps2i, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem07') deallocate(mp3tab1,mp3tab2,mp3tab3,mp3tabi,mp2tab1,mp2tab2,mp2tab3 & ,mp2tabi,mp3stab1,mp2stab1,mp3stab2,mp2stab2,mp3stab3,mp2stab3 & ,mp3stabi,mp2stabi, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem08') deallocate(ivopt3d,ivopt2d,ivopt3ds,ivopt2ds,ivopt3dm, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem09') deallocate(ivopt3m, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem10') deallocate(mp3chr1,mp3chr2,mp3chr3,mp3chri,mp2chr1,mp2chr2,mp2chr3 & ,mp2chri,mp3schr1,mp2schr1,mp3schr2,mp2schr2,mp3schr3,mp2schr3 & ,mp3schri,mp2schri,ivchr3d,ivchr2d,ivchr3ds,ivchr2ds,ivchr3dm, & i_state_chr3D, i_state_chr2D, i_state_chr3Ds, i_state_chr2Ds, & i_state_chr3Dm, ischrp, ischrt, iaerschrp, iaerschrt, iaerschrfi & ,iaerschrff,iaerschraj,iaerschrag,iaerschrrs, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem11') if(naddsc > 0) then deallocate(isclt, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, & procedure_name, 'vtable_mem12') endif if(dust_nb > 0) then deallocate(idustnt, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, & procedure_name, 'vtable_mem12a') endif if(H2Oi_nb > 0) then deallocate(iH2Oint,iH2Odct, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, & procedure_name, 'vtable_mem12b') endif if(CO2i_nb > 0) then deallocate(iCO2int,iCO2dct,iCO2wct, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, & procedure_name, 'vtable_mem12c') endif deallocate(ind3dn,ind2dn,ind3dsn,ind2dsn, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem13') deallocate(ind3d,ind2d,ind3dm,ind2ds,ind3ds, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem14') deallocate(ibux,ibuy,ibuz,ibvx,ibvy,ibvz,ibwx,ibwy,ibwz,ibpx,ibpy,ibpz & ,stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem15') deallocate(ibsx,ibsy,ibsz,ibax,ibay,ibaz, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem16') deallocate(isbpsdensn,isbpstmcpn,isbpstmcdn,isbpslthkn,isbpsqn & ,isbpsh2oan, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem17') deallocate(ipatchfcvn,iz0statn,iz0netn,ialbdstatn,itistatn,isfctempkn & ,isfch2omrn,iustarn,itstarn,irstarn, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem18') deallocate(unvar_bndidx,fi_idx,ff_idx,aj_idx,ag_idx,rs_idx, stat=aerr) if (aerr /= 0) call illegal_alloc_stop(for_deallocation, procedure_name, & 'vtable_mem19') endif end subroutine vtable_mem !``````````````````````````````````````````````````````````````````` subroutine vtable_memidx(igd, switching_grid) !+ Assigns individual variables their memory indices use main_memory_mod, only: naddsc use main_memory_bspec_mod, only: dust_nb, CO2i_nb, H2Oi_nb implicit none !=== Argument declarations: logical, intent(IN) :: switching_grid integer, intent(IN) :: igd !== Local declarations: integer :: nv, iv, idx, iq !=== Executable statements: if (switching_grid) then do nv=1,nv2d(igd) iv = ivtab2d(nv,igd) if(iv == 1) then itopt = itoptn(igd) elseif(iv == 2) then itopu = itopun(igd) elseif(iv == 3) then itopv = itopvn(igd) elseif(iv == 4) then itopm = itopmn(igd) elseif(iv == 5) then irtgt = irtgtn(igd) elseif(iv == 6) then irtgu = irtgun(igd) elseif(iv == 7) then irtgv = irtgvn(igd) elseif(iv == 8) then irtgm = irtgmn(igd) elseif(iv == 9) then if13t = if13tn(igd) elseif(iv == 10) then if13u = if13un(igd) elseif(iv == 11) then if13v = if13vn(igd) elseif(iv == 12) then if13m = if13mn(igd) elseif(iv == 13) then if23t = if23tn(igd) elseif(iv == 14) then if23u = if23un(igd) elseif(iv == 15) then if23v = if23vn(igd) elseif(iv == 16) then if23m = if23mn(igd) elseif(iv == 17) then idxu = idxun(igd) elseif(iv == 18) then idxv = idxvn(igd) elseif(iv == 19) then idxt = idxtn(igd) elseif(iv == 20) then idxm = idxmn(igd) elseif(iv == 21) then idyu = idyun(igd) elseif(iv == 22) then idyv = idyvn(igd) elseif(iv == 23) then idyt = idytn(igd) elseif(iv == 24) then idym = idymn(igd) elseif(iv == 25) then ifmapu = ifmapun(igd) elseif(iv == 26) then ifmapv = ifmapvn(igd) elseif(iv == 27) then ifmapt = ifmaptn(igd) elseif(iv == 28) then ifmapm = ifmapmn(igd) elseif(iv == 29) then ifmapui = ifmapuin(igd) elseif(iv == 30) then ifmapvi = ifmapvin(igd) elseif(iv == 31) then ifmapti = ifmaptin(igd) elseif(iv == 32) then ifmapmi = ifmapmin(igd) elseif(iv == 33) then iglat = iglatn(igd) elseif(iv == 34) then iglon = iglonn(igd) elseif(iv == 35) then iuw = iuwn(igd) elseif(iv == 36) then ivw = ivwn(igd) elseif(iv == 37) then iwfz = iwfzn(igd) elseif(iv == 38) then itfz = itfzn(igd) elseif(iv == 39) then iqfz = iqfzn(igd) elseif(iv == 40) then irshort = irshortn(igd) elseif(iv == 41) then irlong = irlongn(igd) elseif(iv == 42) then irlongup = irlongupn(igd) elseif(iv == 43) then ialbedt = ialbedtn(igd) elseif(iv == 44) then ivarp = ivarpn(igd) elseif(iv == 45) then ivarp2 = ivarp2n(igd) elseif(iv == 46) then ifcoru = ifcorun(igd) elseif(iv == 47) then ifcorv = ifcorvn(igd) elseif(iv == 48) then ivt2da = ivt2dan(igd) elseif(iv == 49) then ivt2db = ivt2dbn(igd) elseif(iv == 50) then ivt2dc = ivt2dcn(igd) elseif(iv == 51) then ivt2dd = ivt2ddn(igd) elseif(iv == 52) then ivt2de = ivt2den(igd) elseif(iv == 53) then ivt2df = ivt2dfn(igd) elseif(iv == 54) then icosz = icoszn(igd) elseif(iv == 55) then itopz0 = itopz0n(igd) elseif(iv == 56) then itslopang = itslopangn(igd) elseif(iv == 57) then itazmang = itazmangn(igd) elseif(iv >= unvar_bndidx(1,3)) then ! Deal with "unknown" variables if(iv < unvar_bndidx(2,3) .and. dust_nb > 0) then iq = unvar_bndidx(1,3) idustfi(iv-iq+1) = idustfin(igd,iv-iq+1) elseif(iv < unvar_bndidx(3,3) .and. H2Oi_nb > 0) then iq = unvar_bndidx(2,3) iH2Oifi(iv-iq+1) = iH2Oifin(igd,iv-iq+1) elseif(iv < unvar_bndidx(4,3) .and. H2Oi_nb > 0) then iq = unvar_bndidx(3,3) iH2Odfi(iv-iq+1) = iH2Odfin(igd,iv-iq+1) elseif(iv < unvar_bndidx(5,3) .and. CO2i_nb > 0) then iq = unvar_bndidx(4,3) iCO2ifi(iv-iq+1) = iCO2ifin(igd,iv-iq+1) elseif(iv < unvar_bndidx(6,3) .and. CO2i_nb > 0) then iq = unvar_bndidx(5,3) iCO2dfi(iv-iq+1) = iCO2dfin(igd,iv-iq+1) elseif(iv < unvar_bndidx(7,3) .and. CO2i_nb > 0) then iq = unvar_bndidx(6,3) iCO2wfi(iv-iq+1) = iCO2wfin(igd,iv-iq+1) elseif(iv < unvar_bndidx(2,4) .and. dust_nb > 0) then iq = unvar_bndidx(1,4) idustff(iv-iq+1) = idustffn(igd,iv-iq+1) elseif(iv < unvar_bndidx(3,4) .and. H2Oi_nb > 0) then iq = unvar_bndidx(2,4) iH2Oiff(iv-iq+1) = iH2Oiffn(igd,iv-iq+1) elseif(iv < unvar_bndidx(4,4) .and. H2Oi_nb > 0) then iq = unvar_bndidx(3,4) iH2Odff(iv-iq+1) = iH2Odffn(igd,iv-iq+1) elseif(iv < unvar_bndidx(5,4) .and. CO2i_nb > 0) then iq = unvar_bndidx(4,4) iCO2iff(iv-iq+1) = iCO2iffn(igd,iv-iq+1) elseif(iv < unvar_bndidx(6,4) .and. CO2i_nb > 0) then iq = unvar_bndidx(5,4) iCO2dff(iv-iq+1) = iCO2dffn(igd,iv-iq+1) elseif(iv < unvar_bndidx(7,4) .and. CO2i_nb > 0) then iq = unvar_bndidx(6,4) iCO2wff(iv-iq+1) = iCO2wffn(igd,iv-iq+1) elseif(iv < unvar_bndidx(2,5) .and. dust_nb > 0) then iq = unvar_bndidx(1,5) idustaj(iv-iq+1) = idustajn(igd,iv-iq+1) elseif(iv < unvar_bndidx(3,5) .and. H2Oi_nb > 0) then iq = unvar_bndidx(2,5) iH2Oiaj(iv-iq+1) = iH2Oiajn(igd,iv-iq+1) elseif(iv < unvar_bndidx(4,5) .and. H2Oi_nb > 0) then iq = unvar_bndidx(3,5) iH2Odaj(iv-iq+1) = iH2Odajn(igd,iv-iq+1) elseif(iv < unvar_bndidx(5,5) .and. CO2i_nb > 0) then iq = unvar_bndidx(4,5) iCO2iaj(iv-iq+1) = iCO2iajn(igd,iv-iq+1) elseif(iv < unvar_bndidx(6,5) .and. CO2i_nb > 0) then iq = unvar_bndidx(5,5) iCO2daj(iv-iq+1) = iCO2dajn(igd,iv-iq+1) elseif(iv < unvar_bndidx(7,5) .and. CO2i_nb > 0) then iq = unvar_bndidx(6,5) iCO2waj(iv-iq+1) = iCO2wajn(igd,iv-iq+1) elseif(iv < unvar_bndidx(2,6) .and. dust_nb > 0) then iq = unvar_bndidx(1,6) idustag(iv-iq+1) = idustagn(igd,iv-iq+1) elseif(iv < unvar_bndidx(3,6) .and. H2Oi_nb > 0) then iq = unvar_bndidx(2,6) iH2Oiag(iv-iq+1) = iH2Oiagn(igd,iv-iq+1) elseif(iv < unvar_bndidx(4,6) .and. H2Oi_nb > 0) then iq = unvar_bndidx(3,6) iH2Odag(iv-iq+1) = iH2Odagn(igd,iv-iq+1) elseif(iv < unvar_bndidx(5,6) .and. CO2i_nb > 0) then iq = unvar_bndidx(4,6) iCO2iag(iv-iq+1) = iCO2iagn(igd,iv-iq+1) elseif(iv < unvar_bndidx(6,6) .and. CO2i_nb > 0) then iq = unvar_bndidx(5,6) iCO2dag(iv-iq+1) = iCO2dagn(igd,iv-iq+1) elseif(iv < unvar_bndidx(7,6) .and. CO2i_nb > 0) then iq = unvar_bndidx(6,6) iCO2wag(iv-iq+1) = iCO2wagn(igd,iv-iq+1) elseif(iv < unvar_bndidx(2,7) .and. dust_nb > 0) then iq = unvar_bndidx(1,7) idustrs(iv-iq+1) = idustrsn(igd,iv-iq+1) elseif(iv < unvar_bndidx(3,7) .and. H2Oi_nb > 0) then iq = unvar_bndidx(2,7) iH2Oirs(iv-iq+1) = iH2Oirsn(igd,iv-iq+1) elseif(iv < unvar_bndidx(4,7) .and. H2Oi_nb > 0) then iq = unvar_bndidx(3,7) iH2Odrs(iv-iq+1) = iH2Odrsn(igd,iv-iq+1) elseif(iv < unvar_bndidx(5,7) .and. CO2i_nb > 0) then iq = unvar_bndidx(4,7) iCO2irs(iv-iq+1) = iCO2irsn(igd,iv-iq+1) elseif(iv < unvar_bndidx(6,7) .and. CO2i_nb > 0) then iq = unvar_bndidx(5,7) iCO2drs(iv-iq+1) = iCO2drsn(igd,iv-iq+1) elseif(iv < unvar_bndidx(7,7) .and. CO2i_nb > 0) then iq = unvar_bndidx(6,7) iCO2wrs(iv-iq+1) = iCO2wrsn(igd,iv-iq+1) endif endif enddo do nv=1,nv2ds(igd) iv = ivtab2ds(nv,igd) if(iv == 1) then ipatchfcv = ipatchfcvn(igd) elseif(iv == 2) then iz0stat = iz0statn(igd) elseif(iv == 3) then iz0net = iz0netn(igd) elseif(iv == 4) then ialbdstat = ialbdstatn(igd) elseif(iv == 5) then itistat = itistatn(igd) elseif(iv == 6) then isfctempk = isfctempkn(igd) elseif(iv == 7) then isfch2omr = isfch2omrn(igd) elseif(iv == 8) then iustar = iustarn(igd) elseif(iv == 9) then itstar = itstarn(igd) elseif(iv == 10) then irstar = irstarn(igd) endif enddo do nv=1,nv3ds(igd) iv = ivtab3ds(nv,igd) if(iv == 1) then isbpsdens = isbpsdensn(igd) elseif(iv == 2) then isbpstmcp = isbpstmcpn(igd) elseif(iv == 3) then isbpstmcd = isbpstmcdn(igd) elseif(iv == 4) then isbpslthk = isbpslthkn(igd) elseif(iv == 5) then isbpsq = isbpsqn(igd) elseif(iv == 6) then isbpsh2oa = isbpsh2oan(igd) endif enddo do nv=1,nv3d(igd) iv = ivtab3d(nv,igd) if(iv == 1) then iup = iupn(igd) elseif(iv == 2) then iuc = iucn(igd) elseif(iv == 3) then ivp = ivpn(igd) elseif(iv == 4) then ivc = ivcn(igd) elseif(iv == 5) then iwp = iwpn(igd) elseif(iv == 6) then iwc = iwcn(igd) elseif(iv == 7) then ipp = ippn(igd) elseif(iv == 8) then ipc = ipcn(igd) elseif(iv == 9) then ithp = ithpn(igd) elseif(iv == 10) then itheta = ithetan(igd) elseif(iv == 11) then itkep = itkepn(igd) elseif(iv == 12) then ifthrd = ifthrdn(igd) elseif(iv == 13) then ivarup = ivarupn(igd) elseif(iv == 14) then ivarvp = ivarvpn(igd) elseif(iv == 15) then ivartp = ivartpn(igd) elseif(iv == 16) then ivarrp = ivarrpn(igd) elseif(iv == 17) then ivaruf = ivarufn(igd) elseif(iv == 18) then ivarvf = ivarvfn(igd) elseif(iv == 19) then ivartf = ivartfn(igd) elseif(iv == 20) then ivarrf = ivarrfn(igd) elseif(iv == 21) then ivarwts = ivarwtsn(igd) elseif(iv == 22) then ipi0 = ipi0n(igd) elseif(iv == 23) then idn0 = idn0n(igd) elseif(iv == 24) then ith0 = ith0n(igd) elseif(iv == 25) then idn0u = idn0un(igd) elseif(iv == 26) then idn0v = idn0vn(igd) elseif(iv == 27) then ihkm = ihkmn(igd) elseif(iv == 28) then ivkm = ivkmn(igd) elseif(iv == 29) then ivkh = ivkhn(igd) elseif(iv == 30) then irv = irvn(igd) elseif(iv >= unvar_bndidx(1,1)) then ! Deal with "unknown" variables if(iv < unvar_bndidx(2,1) .and. dust_nb > 0) then iq = unvar_bndidx(1,1) idustnc(iv-iq+1) = idustncn(igd,iv-iq+1) elseif(iv < unvar_bndidx(3,1) .and. H2Oi_nb > 0) then iq = unvar_bndidx(2,1) iH2Oinc(iv-iq+1) = iH2Oincn(igd,iv-iq+1) elseif(iv < unvar_bndidx(4,1) .and. H2Oi_nb > 0) then iq = unvar_bndidx(3,1) iH2Odcr(iv-iq+1) = iH2Odcrn(igd,iv-iq+1) elseif(iv < unvar_bndidx(5,1) .and. CO2i_nb > 0) then iq = unvar_bndidx(4,1) iCO2inc(iv-iq+1) = iCO2incn(igd,iv-iq+1) elseif(iv < unvar_bndidx(6,1) .and. CO2i_nb > 0) then iq = unvar_bndidx(5,1) iCO2dcr(iv-iq+1) = iCO2dcrn(igd,iv-iq+1) elseif(iv < unvar_bndidx(7,1) .and. CO2i_nb > 0) then iq = unvar_bndidx(6,1) iCO2wcr(iv-iq+1) = iCO2wcrn(igd,iv-iq+1) elseif(iv < unvar_bndidx(8,1) .and. naddsc > 0) then iq = unvar_bndidx(7,1) isclp(iv-iq+1) = isclpn(igd,iv-iq+1) ! "normal" scalars (added) endif endif enddo else ! Fill arrays with memory array indices (model initialization step) if(igd == 0) then ! Fill grid-independent indices do nv=1,nv3dmt iv = ivtab3m(nv) idx = ind3dm(iv) if(iv == 1) then iut = idx elseif(iv == 2) then ivt = idx elseif(iv == 3) then iwt = idx elseif(iv == 4) then ipt = idx elseif(iv == 5) then itht = idx elseif(iv == 6) then irvt = idx elseif(iv == 7) then itket = idx elseif(iv == 8) then ivt3da = idx elseif(iv == 9) then ivt3db = idx elseif(iv == 10) then ivt3dc = idx elseif(iv == 11) then ivt3dd = idx elseif(iv == 12) then ivt3de = idx elseif(iv == 13) then ivt3df = idx elseif(iv == 14) then ivt3dg = idx elseif(iv == 15) then ivt3dh = idx elseif(iv == 16) then ivt3di = idx elseif(iv == 17) then ivt3dj = idx elseif(iv == 18) then ivt3dk = idx elseif(iv == 19) then ivt3dl = idx elseif(iv == 20) then ivt3dm = idx elseif(iv == 21) then ivt3dn = idx elseif(iv == 22) then ivt3do = idx elseif(iv == 23) then ivt3dp = idx elseif(iv >= unvar_bndidx(1,2)) then ! Deal with "unknown" variables if(iv < unvar_bndidx(2,2) .and. dust_nb > 0) then iq = unvar_bndidx(1,2) idustnt(iv-iq+1) = idx elseif(iv < unvar_bndidx(3,2) .and. H2Oi_nb > 0) then iq = unvar_bndidx(2,2) iH2Oint(iv-iq+1) = idx elseif(iv < unvar_bndidx(4,2) .and. H2Oi_nb > 0) then iq = unvar_bndidx(3,2) iH2Odct(iv-iq+1) = idx elseif(iv < unvar_bndidx(5,2) .and. CO2i_nb > 0) then iq = unvar_bndidx(4,2) iCO2int(iv-iq+1) = idx elseif(iv < unvar_bndidx(6,2) .and. CO2i_nb > 0) then iq = unvar_bndidx(5,2) iCO2dct(iv-iq+1) = idx elseif(iv < unvar_bndidx(7,2) .and. CO2i_nb > 0) then iq = unvar_bndidx(6,2) iCO2wct(iv-iq+1) = idx elseif(iv < unvar_bndidx(8,2) .and. naddsc > 0) then iq = unvar_bndidx(7,2) isclt(iv-iq+1) = idx ! "normal" scalars (added) endif endif enddo return ! Done here for now endif do nv=1,nv2d(igd) iv = ivtab2d(nv,igd) idx = ind2dn(igd,iv) if(iv == 1) then itoptn(igd) = idx elseif(iv == 2) then itopun(igd) = idx elseif(iv == 3) then itopvn(igd) = idx elseif(iv == 4) then itopmn(igd) = idx elseif(iv == 5) then irtgtn(igd) = idx elseif(iv == 6) then irtgun(igd) = idx elseif(iv == 7) then irtgvn(igd) = idx elseif(iv == 8) then irtgmn(igd) = idx elseif(iv == 9) then if13tn(igd) = idx elseif(iv == 10) then if13un(igd) = idx elseif(iv == 11) then if13vn(igd) = idx elseif(iv == 12) then if13mn(igd) = idx elseif(iv == 13) then if23tn(igd) = idx elseif(iv == 14) then if23un(igd) = idx elseif(iv == 15) then if23vn(igd) = idx elseif(iv == 16) then if23mn(igd) = idx elseif(iv == 17) then idxun(igd) = idx elseif(iv == 18) then idxvn(igd) = idx elseif(iv == 19) then idxtn(igd) = idx elseif(iv == 20) then idxmn(igd) = idx elseif(iv == 21) then idyun(igd) = idx elseif(iv == 22) then idyvn(igd) = idx elseif(iv == 23) then idytn(igd) = idx elseif(iv == 24) then idymn(igd) = idx elseif(iv == 25) then ifmapun(igd) = idx elseif(iv == 26) then ifmapvn(igd) = idx elseif(iv == 27) then ifmaptn(igd) = idx elseif(iv == 28) then ifmapmn(igd) = idx elseif(iv == 29) then ifmapuin(igd) = idx elseif(iv == 30) then ifmapvin(igd) = idx elseif(iv == 31) then ifmaptin(igd) = idx elseif(iv == 32) then ifmapmin(igd) = idx elseif(iv == 33) then iglatn(igd) = idx elseif(iv == 34) then iglonn(igd) = idx elseif(iv == 35) then iuwn(igd) = idx elseif(iv == 36) then ivwn(igd) = idx elseif(iv == 37) then iwfzn(igd) = idx elseif(iv == 38) then itfzn(igd) = idx elseif(iv == 39) then iqfzn(igd) = idx elseif(iv == 40) then irshortn(igd) = idx elseif(iv == 41) then irlongn(igd) = idx elseif(iv == 42) then irlongupn(igd) = idx elseif(iv == 43) then ialbedtn(igd) = idx elseif(iv == 44) then ivarpn(igd) = idx elseif(iv == 45) then ivarp2n(igd) = idx elseif(iv == 46) then ifcorun(igd) = idx elseif(iv == 47) then ifcorvn(igd) = idx elseif(iv == 48) then ivt2dan(igd) = idx elseif(iv == 49) then ivt2dbn(igd) = idx elseif(iv == 50) then ivt2dcn(igd) = idx elseif(iv == 51) then ivt2ddn(igd) = idx elseif(iv == 52) then ivt2den(igd) = idx elseif(iv == 53) then ivt2dfn(igd) = idx elseif(iv == 54) then icoszn(igd) = idx elseif(iv == 55) then itopz0n(igd) = idx elseif(iv == 56) then itslopangn(igd) = idx elseif(iv == 57) then itazmangn(igd) = idx elseif(iv >= unvar_bndidx(1,3)) then ! Deal with "unknown" variables if(iv < unvar_bndidx(2,3) .and. dust_nb > 0) then iq = unvar_bndidx(1,3) idustfin(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(3,3) .and. H2Oi_nb > 0) then iq = unvar_bndidx(2,3) iH2Oifin(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(4,3) .and. H2Oi_nb > 0) then iq = unvar_bndidx(3,3) iH2Odfin(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(5,3) .and. CO2i_nb > 0) then iq = unvar_bndidx(4,3) iCO2ifin(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(6,3) .and. CO2i_nb > 0) then iq = unvar_bndidx(5,3) iCO2dfin(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(7,3) .and. CO2i_nb > 0) then iq = unvar_bndidx(6,3) iCO2wfin(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(2,4) .and. dust_nb > 0) then iq = unvar_bndidx(1,4) idustffn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(3,4) .and. H2Oi_nb > 0) then iq = unvar_bndidx(2,4) iH2Oiffn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(4,4) .and. H2Oi_nb > 0) then iq = unvar_bndidx(3,4) iH2Odffn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(5,4) .and. CO2i_nb > 0) then iq = unvar_bndidx(4,4) iCO2iffn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(6,4) .and. CO2i_nb > 0) then iq = unvar_bndidx(5,4) iCO2dffn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(7,4) .and. CO2i_nb > 0) then iq = unvar_bndidx(6,4) iCO2wffn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(2,5) .and. dust_nb > 0) then iq = unvar_bndidx(1,5) idustajn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(3,5) .and. H2Oi_nb > 0) then iq = unvar_bndidx(2,5) iH2Oiajn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(4,5) .and. H2Oi_nb > 0) then iq = unvar_bndidx(3,5) iH2Odajn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(5,5) .and. CO2i_nb > 0) then iq = unvar_bndidx(4,5) iCO2iajn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(6,5) .and. CO2i_nb > 0) then iq = unvar_bndidx(5,5) iCO2dajn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(7,5) .and. CO2i_nb > 0) then iq = unvar_bndidx(6,5) iCO2wajn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(2,6) .and. dust_nb > 0) then iq = unvar_bndidx(1,6) idustagn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(3,6) .and. H2Oi_nb > 0) then iq = unvar_bndidx(2,6) iH2Oiagn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(4,6) .and. H2Oi_nb > 0) then iq = unvar_bndidx(3,6) iH2Odagn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(5,6) .and. CO2i_nb > 0) then iq = unvar_bndidx(4,6) iCO2iagn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(6,6) .and. CO2i_nb > 0) then iq = unvar_bndidx(5,6) iCO2dagn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(7,6) .and. CO2i_nb > 0) then iq = unvar_bndidx(6,6) iCO2wagn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(2,7) .and. dust_nb > 0) then iq = unvar_bndidx(1,7) idustrsn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(3,7) .and. H2Oi_nb > 0) then iq = unvar_bndidx(2,7) iH2Oirsn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(4,7) .and. H2Oi_nb > 0) then iq = unvar_bndidx(3,7) iH2Odrsn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(5,7) .and. CO2i_nb > 0) then iq = unvar_bndidx(4,7) iCO2irsn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(6,7) .and. CO2i_nb > 0) then iq = unvar_bndidx(5,7) iCO2drsn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(7,7) .and. CO2i_nb > 0) then iq = unvar_bndidx(6,7) iCO2wrsn(igd,iv-iq+1) = idx endif endif enddo do nv=1,nv2ds(igd) iv = ivtab2ds(nv,igd) idx = ind2dsn(igd,iv) if(iv == 1) then ipatchfcvn(igd) = idx elseif(iv == 2) then iz0statn(igd) = idx elseif(iv == 3) then iz0netn(igd) = idx elseif(iv == 4) then ialbdstatn(igd) = idx elseif(iv == 5) then itistatn(igd) = idx elseif(iv == 6) then isfctempkn(igd) = idx elseif(iv == 7) then isfch2omrn(igd) = idx elseif(iv == 8) then iustarn(igd) = idx elseif(iv == 9) then itstarn(igd) = idx elseif(iv == 10) then irstarn(igd) = idx endif enddo do nv=1,nv3ds(igd) iv = ivtab3ds(nv,igd) idx = ind3dsn(igd,iv) if(iv == 1) then isbpsdensn(igd) = idx elseif(iv == 2) then isbpstmcpn(igd) = idx elseif(iv == 3) then isbpstmcdn(igd) = idx elseif(iv == 4) then isbpslthkn(igd) = idx elseif(iv == 5) then isbpsqn(igd) = idx elseif(iv == 6) then isbpsh2oan(igd) = idx endif enddo do nv=1,nv3d(igd) iv = ivtab3d(nv,igd) idx = ind3dn(igd,iv) if(iv == 1) then iupn(igd) = idx elseif(iv == 2) then iucn(igd) = idx elseif(iv == 3) then ivpn(igd) = idx elseif(iv == 4) then ivcn(igd) = idx elseif(iv == 5) then iwpn(igd) = idx elseif(iv == 6) then iwcn(igd) = idx elseif(iv == 7) then ippn(igd) = idx elseif(iv == 8) then ipcn(igd) = idx elseif(iv == 9) then ithpn(igd) = idx elseif(iv == 10) then ithetan(igd) = idx elseif(iv == 11) then itkepn(igd) = idx elseif(iv == 12) then ifthrdn(igd) = idx elseif(iv == 13) then ivarupn(igd) = idx elseif(iv == 14) then ivarvpn(igd) = idx elseif(iv == 15) then ivartpn(igd) = idx elseif(iv == 16) then ivarrpn(igd) = idx elseif(iv == 17) then ivarufn(igd) = idx elseif(iv == 18) then ivarvfn(igd) = idx elseif(iv == 19) then ivartfn(igd) = idx elseif(iv == 20) then ivarrfn(igd) = idx elseif(iv == 21) then ivarwtsn(igd) = idx elseif(iv == 22) then ipi0n(igd) = idx elseif(iv == 23) then idn0n(igd) = idx elseif(iv == 24) then ith0n(igd) = idx elseif(iv == 25) then idn0un(igd) = idx elseif(iv == 26) then idn0vn(igd) = idx elseif(iv == 27) then ihkmn(igd) = idx elseif(iv == 28) then ivkmn(igd) = idx elseif(iv == 29) then ivkhn(igd) = idx elseif(iv == 30) then irvn(igd) = idx elseif(iv >= unvar_bndidx(1,1)) then ! Deal with "unknown" variables if(iv < unvar_bndidx(2,1) .and. dust_nb > 0) then iq = unvar_bndidx(1,1) idustncn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(3,1) .and. H2Oi_nb > 0) then iq = unvar_bndidx(2,1) iH2Oincn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(4,1) .and. H2Oi_nb > 0) then iq = unvar_bndidx(3,1) iH2Odcrn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(5,1) .and. CO2i_nb > 0) then iq = unvar_bndidx(4,1) iCO2incn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(6,1) .and. CO2i_nb > 0) then iq = unvar_bndidx(5,1) iCO2dcrn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(7,1) .and. CO2i_nb > 0) then iq = unvar_bndidx(6,1) iCO2wcrn(igd,iv-iq+1) = idx elseif(iv < unvar_bndidx(8,1) .and. naddsc > 0) then iq = unvar_bndidx(7,1) isclpn(igd,iv-iq+1) = idx ! "Normal" scalars (added) endif endif enddo endif end subroutine vtable_memidx end module vtables_mod