Changeset 2713


Ignore:
Timestamp:
12/09/09 09:52:09 (15 years ago)
Author:
Mathieu Morlighem
Message:

arranged functions in alphabetical order

Location:
issm/trunk/src/c/objects
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • issm/trunk/src/c/objects/Penta.cpp

    r2711 r2713  
    1616#include "../include/typedefs.h"
    1717
     18/*Object constructors and destructor*/
    1819/*FUNCTION Penta constructor {{{1*/
    1920Penta::Penta(){
    … …  
    7071}
    7172/*}}}*/
    72 /*FUNCTION Penta Echo {{{1*/
    73 void Penta::Echo(void){
    74 
    75         printf("Penta:\n");
    76         printf("   id: %i\n",id);
    77         printf("   mid: %i\n",mid);
    78         printf("   mparid: %i\n",mparid);
    79         printf("   numparid: %i\n",numparid);
    80 
    81         printf("   node_ids=[%i,%i,%i,%i,%i,%i]\n",node_ids[0],node_ids[1],node_ids[2],node_ids[3],node_ids[4],node_ids[5]);
    82         printf("   node_offsets=[%i,%i,%i,%i,%i,%i]\n",node_offsets[0],node_offsets[1],node_offsets[2],node_offsets[3],node_offsets[4],node_offsets[5]);
    83         printf("   matice_offset=%i\n",matice_offset);
    84         printf("   matpar_offset=%i\n",matpar_offset);
    85 
    86         printf("   h=[%g,%g,%g,%g,%g,%g]\n",h[0],h[1],h[2],h[3],h[4],h[5]);
    87         printf("   s=[%g,%g,%g,%g,%g,%g]\n",s[0],s[1],s[2],s[3],s[4],s[5]);
    88         printf("   b=[%g,%g,%g,%g,%g,%g]\n",b[0],b[1],b[2],b[3],b[4],b[5]);
    89         printf("   k=[%g,%g,%g,%g,%g,%g]\n",k[0],k[1],k[2],k[3],k[4],k[5]);
    90 
    91         printf("   friction_type: %i\n",friction_type);
    92         printf("   p: %g\n",p);
    93         printf("   q: %g\n",q);
    94         printf("   shelf: %i\n",shelf);
    95         printf("   onbed: %i\n",onbed);
    96         printf("   onwater: %i\n",onwater);
    97         printf("   onsurface: %i\n",onsurface);
    98         printf("   collapse: %i\n",collapse);
    99 
    100         printf("   melting=[%g,%g,%g,%g,%g,%g]\n",melting[0],melting[1],melting[2],melting[3],melting[4],melting[5]);
    101         printf("   accumulation=[%g,%g,%g,%g,%g,%g]\n",accumulation[0],accumulation[1],accumulation[2],accumulation[3],accumulation[4],accumulation[5]);
    102         printf("   geothermalflux=[%g,%g,%g,%g,%g,%g]\n",geothermalflux[0],geothermalflux[1],geothermalflux[2],geothermalflux[3],geothermalflux[4],geothermalflux[5]);
    103         printf("   thermal_steadystate: %i\n",thermal_steadystate);
    104         return;
    105 }
    106 /*}}}*/
    107 /*FUNCTION Penta DeepEcho {{{1*/
    108 void Penta::DeepEcho(void){
    109 
    110         printf("Penta:\n");
    111         printf("   id: %i\n",id);
    112         printf("   mid: %i\n",mid);
    113         printf("   mparid: %i\n",mparid);
    114         printf("   numparid: %i\n",numparid);
    115 
    116         printf("   node_ids=[%i,%i,%i,%i,%i,%i]\n",node_ids[0],node_ids[1],node_ids[2],node_ids[3],node_ids[4],node_ids[5]);
    117         printf("   node_offsets=[%i,%i,%i,%i,%i,%i]\n",node_offsets[0],node_offsets[1],node_offsets[2],node_offsets[3],node_offsets[4],node_offsets[5]);
    118         printf("   matice_offset=%i\n",matice_offset);
    119         printf("   matpar_offset=%i\n",matpar_offset);
    120 
    121         printf("   h=[%i,%i,%i,%i,%i,%i]\n",h[0],h[1],h[2],h[3],h[4],h[5]);
    122         printf("   s=[%i,%i,%i,%i,%i,%i]\n",s[0],s[1],s[2],s[3],s[4],s[5]);
    123         printf("   b=[%i,%i,%i,%i,%i,%i]\n",b[0],b[1],b[2],b[3],b[4],b[5]);
    124         printf("   k=[%i,%i,%i,%i,%i,%i]\n",k[0],k[1],k[2],k[3],k[4],k[5]);
    125 
    126         printf("   friction_type: %i\n",friction_type);
    127         printf("   p: %g\n",p);
    128         printf("   q: %g\n",q);
    129         printf("   shelf: %i\n",shelf);
    130         printf("   onbed: %i\n",onbed);
    131         printf("   onwater: %i\n",onwater);
    132         printf("   onsurface: %i\n",onsurface);
    133         printf("   collapse: %i\n",collapse);
    134 
    135         printf("   melting=[%i,%i,%i,%i,%i,%i]\n",melting[0],melting[1],melting[2],melting[3],melting[4],melting[5]);
    136         printf("   accumulation=[%i,%i,%i,%i,%i,%i]\n",accumulation[0],accumulation[1],accumulation[2],accumulation[3],accumulation[4],accumulation[5]);
    137         printf("   geothermalflux=[%i,%i,%i,%i,%i,%i]\n",geothermalflux[0],geothermalflux[1],geothermalflux[2],geothermalflux[3],geothermalflux[4],geothermalflux[5]);
    138         printf("   thermal_steadystate: %i\n",thermal_steadystate);
    139         return;
    140 }
    141 /*}}}*/
    142 /*FUNCTION Penta Marshall {{{1*/
     73
     74/*Object marshall*/
     75/*FUNCTION Marshall {{{1*/
    14376void  Penta::Marshall(char** pmarshalled_dataset){
    14477
    … …  
    190123}
    191124/*}}}*/
    192 /*FUNCTION Penta MarshallSize {{{1*/
     125/*FUNCTION MarshallSize {{{1*/
    193126int   Penta::MarshallSize(){
    194127
    … …  
    225158}
    226159/*}}}*/
    227 /*FUNCTION Penta GetName {{{1*/
    228 char* Penta::GetName(void){
    229         return "penta";
    230 }
    231 /*}}}*/
    232 /*FUNCTION Penta Demarshall {{{1*/
     160/*FUNCTION Demarshall {{{1*/
    233161void  Penta::Demarshall(char** pmarshalled_dataset){
    234162
    … …  
    283211}
    284212/*}}}*/
    285 /*FUNCTION Penta Enum {{{1*/
    286 int Penta::Enum(void){
    287 
    288         return PentaEnum();
    289 
    290 }
    291 /*}}}*/
    292 /*FUNCTION Penta GetId {{{1*/
    293 int    Penta::GetId(void){
    294         return id;
    295 }
    296 /*}}}*/
    297 /*FUNCTION Penta MyRank {{{1*/
    298 int    Penta::MyRank(void){
    299         extern int my_rank;
    300         return my_rank;
    301 }
    302 /*}}}*/
    303 /*FUNCTION Penta Configure {{{1*/
    304 #undef __FUConfigure NCT__
     213
     214/*Object functions*/
     215/*FUNCTION ComputePressure {{{1*/
     216#undef __FUNCT__
     217#define __FUNCT__ "Penta::ComputePressure"
     218void  Penta::ComputePressure(Vec pg){
     219
     220        int i;
     221        const int numgrids=6;
     222        int doflist[numgrids];
     223        double pressure[numgrids];
     224        double rho_ice,g;
     225        double       xyz_list[numgrids][3];
     226
     227        /*If on water, skip: */
     228        if(onwater)return;
     229
     230        /*Get node data: */
     231        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     232
     233        /*pressure is lithostatic: */
     234        //md.pressure=md.rho_ice*md.g*(md.surface-md.z); a la matlab
     235
     236        /*Get dof list on which we will plug the pressure values: */
     237        GetDofList1(&doflist[0]);
     238
     239        /*pressure is lithostatic: */
     240        rho_ice=matpar->GetRhoIce();
     241        g=matpar->GetG();
     242        for(i=0;i<numgrids;i++){
     243                pressure[i]=rho_ice*g*(s[i]-xyz_list[i][2]);
     244        }
     245
     246        /*plug local pressure values into global pressure vector: */
     247        VecSetValues(pg,numgrids,doflist,(const double*)pressure,INSERT_VALUES);
     248
     249}
     250/*}}}*/
     251/*FUNCTION Configure {{{1*/
     252#undef __FUNCT__
    305253#define __FUNCT__ "Penta::Configure"
    306254void  Penta::Configure(void* ploadsin,void* pnodesin,void* pmaterialsin,void* pparametersin){
    … …  
    331279}
    332280/*}}}*/
    333 /*FUNCTION Penta CreateKMatrix {{{1*/
     281/*FUNCTION copy {{{1*/
     282Object* Penta::copy() {
     283        return new Penta(*this);
     284}
     285/*}}}*/
     286/*FUNCTION CreateKMatrix {{{1*/
    334287#undef __FUNCT__
    335288#define __FUNCT__ "Penta::CreateKMatrix"
    … …  
    382335}
    383336/*}}}*/
    384 /*FUNCTION Penta CreateKMatrixDiagnosticHoriz {{{1*/
     337/*FUNCTION CreateKMatrixDiagnosticHoriz {{{1*/
    385338#undef __FUNCT__
    386339#define __FUNCT__ "Penta:CreateKMatrixDiagnosticHoriz"
    … …  
    641594}
    642595/*}}}*/
    643 /*FUNCTION Penta CreateKMatrixDiagnosticVert {{{1*/
    644 #undef __FUNCT__
    645 #define __FUNCT__ "Penta:CreateKMatrixDiagnosticVert"
    646 void Penta::CreateKMatrixDiagnosticVert( Mat Kgg, void* vinputs, int analysis_type,int sub_analysis_type){
    647 
    648         /* local declarations */
    649         int             i,j;
    650 
    651         /* node data: */
    652         const int    numgrids=6;
    653         const int    NDOF1=1;
    654         const int    numdof=NDOF1*numgrids;
    655         double       xyz_list[numgrids][3];
    656         int          doflist[numdof];
    657         int          numberofdofspernode;
    658 
    659         /* 3d gaussian points: */
    660         int     num_gauss,ig;
    661         double* first_gauss_area_coord  =  NULL;
    662         double* second_gauss_area_coord =  NULL;
    663         double* third_gauss_area_coord  =  NULL;
    664         double* fourth_gauss_vert_coord  =  NULL;
    665         double* area_gauss_weights           =  NULL;
    666         double* vert_gauss_weights           =  NULL;
    667         int     ig1,ig2;
    668         double  gauss_weight1,gauss_weight2;
    669         double  gauss_l1l2l3l4[4];
    670         int     order_area_gauss;
    671         int     num_vert_gauss;
    672         int     num_area_gauss;
    673         double  gauss_weight;
    674 
    675         /* matrices: */
    676         double  Ke_gg[numdof][numdof];
    677         double  Ke_gg_gaussian[numdof][numdof];
    678         double  Jdet;
    679         double  B[NDOF1][numgrids];
    680         double  Bprime[NDOF1][numgrids];
    681         double  DL_scalar;
    682 
    683         ParameterInputs* inputs=NULL;
    684 
    685         /*Collapsed formulation: */
    686         Tria*  tria=NULL;
    687 
    688         /*If on water, skip stiffness: */
    689         if(onwater)return;
    690 
    691         /*recover pointers: */
    692         inputs=(ParameterInputs*)vinputs;
    693 
    694 
    695         /*If this element  is on the surface, we have a dynamic boundary condition that applies, as a stiffness
    696          * matrix: */
    697         if(onsurface){
    698                 tria=(Tria*)SpawnTria(3,4,5); //nodes 3,4 and 5 are on the surface
    699                 tria->CreateKMatrixDiagnosticSurfaceVert(Kgg,inputs, analysis_type,sub_analysis_type);
    700                 delete tria;
    701         }
    702 
    703         /*Now, onto the formulation for the vertical velocity: */
    704 
    705         /* Get node coordinates and dof list: */
    706         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    707         GetDofList(&doflist[0],&numberofdofspernode);
    708 
    709         /* Set Ke_gg to 0: */
    710         for(i=0;i<numdof;i++){
    711                 for(j=0;j<numdof;j++){
    712                         Ke_gg[i][j]=0.0;
    713                 }
    714         }
    715 
    716         /*Get gaussian points and weights. Penta is an extrusion of a Tria, we therefore
    717           get tria gaussian points as well as segment gaussian points. For tria gaussian
    718           points, order of integration is 2, because we need to integrate the product tB*D*B'
    719           which is a polynomial of degree 3 (see GaussTria for more details). For segment gaussian
    720           points, same deal, which yields 3 gaussian points.*/
    721 
    722         order_area_gauss=2;
    723         num_vert_gauss=2;
    724 
    725         GaussPenta( &num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &area_gauss_weights, &fourth_gauss_vert_coord,&vert_gauss_weights,order_area_gauss,num_vert_gauss);
    726 #ifdef _ISSM_DEBUG_
    727         for (i=0;i<num_area_gauss;i++){
    728                 printf("Area Gauss coord %i: %lf %lf %lf Weight: %lf\n",i,*(first_gauss_area_coord+i),*(second_gauss_area_coord+i),*(third_gauss_area_coord+i),*(area_gauss_weights+i));
    729         }
    730         for (i=0;i<num_vert_gauss;i++){
    731                 printf("Vert Gauss coord %i: %lf Weight: %lf\n",i,*(fourth_gauss_vert_coord+i),*(vert_gauss_weights+i));
    732         }
    733 #endif
    734 
    735         /* Start  looping on the number of gaussian points: */
    736         for (ig1=0; ig1<num_area_gauss; ig1++){
    737                 for (ig2=0; ig2<num_vert_gauss; ig2++){
    738 
    739                         /*Pick up the gaussian point: */
    740                         gauss_weight1=*(area_gauss_weights+ig1);
    741                         gauss_weight2=*(vert_gauss_weights+ig2);
    742                         gauss_weight=gauss_weight1*gauss_weight2;
    743 
    744                         gauss_l1l2l3l4[0]=*(first_gauss_area_coord+ig1);
    745                         gauss_l1l2l3l4[1]=*(second_gauss_area_coord+ig1);
    746                         gauss_l1l2l3l4[2]=*(third_gauss_area_coord+ig1);
    747                         gauss_l1l2l3l4[3]=*(fourth_gauss_vert_coord+ig2);
    748 
    749                         /*Get B and Bprime matrices: */
    750                         GetB_vert(&B[0][0], &xyz_list[0][0], gauss_l1l2l3l4);
    751                         GetBPrime_vert(&Bprime[0][0], &xyz_list[0][0], gauss_l1l2l3l4);
    752 
    753                         /* Get Jacobian determinant: */
    754                         GetJacobianDeterminant(&Jdet, &xyz_list[0][0],gauss_l1l2l3l4);
    755                         DL_scalar=gauss_weight*Jdet;
    756 
    757                         /*  Do the triple product tB*D*Bprime: */
    758                         TripleMultiply( &B[0][0],1,numgrids,1,
    759                                                 &DL_scalar,1,1,0,
    760                                                 &Bprime[0][0],1,numgrids,0,
    761                                                 &Ke_gg_gaussian[0][0],0);
    762 
    763                         /* Add the Ke_gg_gaussian, and optionally Ke_gg_drag_gaussian onto Ke_gg: */
    764                         for( i=0; i<numdof; i++){
    765                                 for(j=0;j<numdof;j++){
    766                                         Ke_gg[i][j]+=Ke_gg_gaussian[i][j];
    767                                 }
    768                         }       
    769                 } //for (ig2=0; ig2<num_vert_gauss; ig2++)
    770         } //for (ig1=0; ig1<num_area_gauss; ig1++)
    771 
    772         /*Add Ke_gg to global matrix Kgg: */
    773         MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)Ke_gg,ADD_VALUES);
    774 
    775 cleanup_and_return:
    776         xfree((void**)&first_gauss_area_coord);
    777         xfree((void**)&second_gauss_area_coord);
    778         xfree((void**)&third_gauss_area_coord);
    779         xfree((void**)&fourth_gauss_vert_coord);
    780         xfree((void**)&area_gauss_weights);
    781         xfree((void**)&vert_gauss_weights);
    782 }
    783 /*}}}*/
    784 /*FUNCTION Penta CreateKMatrixDiagnosticStokes {{{1*/
     596/*FUNCTION CreateKMatrixDiagnosticStokes {{{1*/
    785597#undef __FUNCT__
    786598#define __FUNCT__ "Penta:CreateKMatrixDiagnosticStokes"
    … …  
    1068880}
    1069881/*}}}*/
    1070 /*FUNCTION Penta CreatePVector {{{1*/
     882/*FUNCTION CreateKMatrixDiagnosticVert {{{1*/
     883#undef __FUNCT__
     884#define __FUNCT__ "Penta:CreateKMatrixDiagnosticVert"
     885void Penta::CreateKMatrixDiagnosticVert( Mat Kgg, void* vinputs, int analysis_type,int sub_analysis_type){
     886
     887        /* local declarations */
     888        int             i,j;
     889
     890        /* node data: */
     891        const int    numgrids=6;
     892        const int    NDOF1=1;
     893        const int    numdof=NDOF1*numgrids;
     894        double       xyz_list[numgrids][3];
     895        int          doflist[numdof];
     896        int          numberofdofspernode;
     897
     898        /* 3d gaussian points: */
     899        int     num_gauss,ig;
     900        double* first_gauss_area_coord  =  NULL;
     901        double* second_gauss_area_coord =  NULL;
     902        double* third_gauss_area_coord  =  NULL;
     903        double* fourth_gauss_vert_coord  =  NULL;
     904        double* area_gauss_weights           =  NULL;
     905        double* vert_gauss_weights           =  NULL;
     906        int     ig1,ig2;
     907        double  gauss_weight1,gauss_weight2;
     908        double  gauss_l1l2l3l4[4];
     909        int     order_area_gauss;
     910        int     num_vert_gauss;
     911        int     num_area_gauss;
     912        double  gauss_weight;
     913
     914        /* matrices: */
     915        double  Ke_gg[numdof][numdof];
     916        double  Ke_gg_gaussian[numdof][numdof];
     917        double  Jdet;
     918        double  B[NDOF1][numgrids];
     919        double  Bprime[NDOF1][numgrids];
     920        double  DL_scalar;
     921
     922        ParameterInputs* inputs=NULL;
     923
     924        /*Collapsed formulation: */
     925        Tria*  tria=NULL;
     926
     927        /*If on water, skip stiffness: */
     928        if(onwater)return;
     929
     930        /*recover pointers: */
     931        inputs=(ParameterInputs*)vinputs;
     932
     933
     934        /*If this element  is on the surface, we have a dynamic boundary condition that applies, as a stiffness
     935         * matrix: */
     936        if(onsurface){
     937                tria=(Tria*)SpawnTria(3,4,5); //nodes 3,4 and 5 are on the surface
     938                tria->CreateKMatrixDiagnosticSurfaceVert(Kgg,inputs, analysis_type,sub_analysis_type);
     939                delete tria;
     940        }
     941
     942        /*Now, onto the formulation for the vertical velocity: */
     943
     944        /* Get node coordinates and dof list: */
     945        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     946        GetDofList(&doflist[0],&numberofdofspernode);
     947
     948        /* Set Ke_gg to 0: */
     949        for(i=0;i<numdof;i++){
     950                for(j=0;j<numdof;j++){
     951                        Ke_gg[i][j]=0.0;
     952                }
     953        }
     954
     955        /*Get gaussian points and weights. Penta is an extrusion of a Tria, we therefore
     956          get tria gaussian points as well as segment gaussian points. For tria gaussian
     957          points, order of integration is 2, because we need to integrate the product tB*D*B'
     958          which is a polynomial of degree 3 (see GaussTria for more details). For segment gaussian
     959          points, same deal, which yields 3 gaussian points.*/
     960
     961        order_area_gauss=2;
     962        num_vert_gauss=2;
     963
     964        GaussPenta( &num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &area_gauss_weights, &fourth_gauss_vert_coord,&vert_gauss_weights,order_area_gauss,num_vert_gauss);
     965#ifdef _ISSM_DEBUG_
     966        for (i=0;i<num_area_gauss;i++){
     967                printf("Area Gauss coord %i: %lf %lf %lf Weight: %lf\n",i,*(first_gauss_area_coord+i),*(second_gauss_area_coord+i),*(third_gauss_area_coord+i),*(area_gauss_weights+i));
     968        }
     969        for (i=0;i<num_vert_gauss;i++){
     970                printf("Vert Gauss coord %i: %lf Weight: %lf\n",i,*(fourth_gauss_vert_coord+i),*(vert_gauss_weights+i));
     971        }
     972#endif
     973
     974        /* Start  looping on the number of gaussian points: */
     975        for (ig1=0; ig1<num_area_gauss; ig1++){
     976                for (ig2=0; ig2<num_vert_gauss; ig2++){
     977
     978                        /*Pick up the gaussian point: */
     979                        gauss_weight1=*(area_gauss_weights+ig1);
     980                        gauss_weight2=*(vert_gauss_weights+ig2);
     981                        gauss_weight=gauss_weight1*gauss_weight2;
     982
     983                        gauss_l1l2l3l4[0]=*(first_gauss_area_coord+ig1);
     984                        gauss_l1l2l3l4[1]=*(second_gauss_area_coord+ig1);
     985                        gauss_l1l2l3l4[2]=*(third_gauss_area_coord+ig1);
     986                        gauss_l1l2l3l4[3]=*(fourth_gauss_vert_coord+ig2);
     987
     988                        /*Get B and Bprime matrices: */
     989                        GetB_vert(&B[0][0], &xyz_list[0][0], gauss_l1l2l3l4);
     990                        GetBPrime_vert(&Bprime[0][0], &xyz_list[0][0], gauss_l1l2l3l4);
     991
     992                        /* Get Jacobian determinant: */
     993                        GetJacobianDeterminant(&Jdet, &xyz_list[0][0],gauss_l1l2l3l4);
     994                        DL_scalar=gauss_weight*Jdet;
     995
     996                        /*  Do the triple product tB*D*Bprime: */
     997                        TripleMultiply( &B[0][0],1,numgrids,1,
     998                                                &DL_scalar,1,1,0,
     999                                                &Bprime[0][0],1,numgrids,0,
     1000                                                &Ke_gg_gaussian[0][0],0);
     1001
     1002                        /* Add the Ke_gg_gaussian, and optionally Ke_gg_drag_gaussian onto Ke_gg: */
     1003                        for( i=0; i<numdof; i++){
     1004                                for(j=0;j<numdof;j++){
     1005                                        Ke_gg[i][j]+=Ke_gg_gaussian[i][j];
     1006                                }
     1007                        }       
     1008                } //for (ig2=0; ig2<num_vert_gauss; ig2++)
     1009        } //for (ig1=0; ig1<num_area_gauss; ig1++)
     1010
     1011        /*Add Ke_gg to global matrix Kgg: */
     1012        MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)Ke_gg,ADD_VALUES);
     1013
     1014cleanup_and_return:
     1015        xfree((void**)&first_gauss_area_coord);
     1016        xfree((void**)&second_gauss_area_coord);
     1017        xfree((void**)&third_gauss_area_coord);
     1018        xfree((void**)&fourth_gauss_vert_coord);
     1019        xfree((void**)&area_gauss_weights);
     1020        xfree((void**)&vert_gauss_weights);
     1021}
     1022/*}}}*/
     1023/*FUNCTION CreateKMatrixMelting {{{1*/
     1024#undef __FUNCT__
     1025#define __FUNCT__ "Penta::CreateKMatrixMelting"
     1026void  Penta::CreateKMatrixMelting(Mat Kgg,void* inputs,int analysis_type,int sub_analysis_type){
     1027
     1028        Tria* tria=NULL;
     1029
     1030        /*If on water, skip: */
     1031        if(onwater)return;
     1032
     1033        if (!onbed){
     1034                return;
     1035        }
     1036        else{
     1037
     1038                tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
     1039                tria->CreateKMatrixMelting(Kgg,inputs, analysis_type,sub_analysis_type);
     1040                delete tria;
     1041                return;
     1042        }
     1043}
     1044/*}}}*/
     1045/*FUNCTION CreateKMatrixPrognostic {{{1*/
     1046#undef __FUNCT__
     1047#define __FUNCT__ "Penta::CreateKMatrixPrognostic"
     1048
     1049void  Penta::CreateKMatrixPrognostic(Mat Kgg,void* inputs,int analysis_type,int sub_analysis_type){
     1050
     1051        /*Collapsed formulation: */
     1052        Tria*  tria=NULL;
     1053
     1054        /*If on water, skip: */
     1055        if(onwater)return;
     1056
     1057        /*Is this element on the bed? :*/
     1058        if(!onbed)return;
     1059
     1060        /*Spawn Tria element from the base of the Penta: */
     1061        tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
     1062        tria->CreateKMatrix(Kgg,inputs, analysis_type,sub_analysis_type);
     1063        delete tria;
     1064        return;
     1065
     1066}
     1067/*}}}*/
     1068/*FUNCTION CreateKMatrixSlopeCompute {{{1*/
     1069#undef __FUNCT__
     1070#define __FUNCT__ "Penta::CreateKMatrixSlopeCompute"
     1071
     1072void  Penta::CreateKMatrixSlopeCompute(Mat Kgg,void* inputs,int analysis_type,int sub_analysis_type){
     1073
     1074        /*Collapsed formulation: */
     1075        Tria*  tria=NULL;
     1076
     1077        /*If on water, skip: */
     1078        if(onwater)return;
     1079
     1080        /*Is this element on the bed? :*/
     1081        if(!onbed)return;
     1082
     1083        /*Spawn Tria element from the base of the Penta: */
     1084        tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
     1085        tria->CreateKMatrix(Kgg,inputs, analysis_type,sub_analysis_type);
     1086        delete tria;
     1087        return;
     1088
     1089}
     1090/*}}}*/
     1091/*FUNCTION CreateKMatrixThermal {{{1*/
     1092#undef __FUNCT__
     1093#define __FUNCT__ "Penta::CreateKMatrixThermal"
     1094void  Penta::CreateKMatrixThermal(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
     1095
     1096        /* local declarations */
     1097        int i,j;
     1098        int found=0;
     1099
     1100        /* node data: */
     1101        const int    numgrids=6;
     1102        const int    NDOF1=1;
     1103        const int    numdof=NDOF1*numgrids;
     1104        double xyz_list[numgrids][3];
     1105        int    doflist[numdof];
     1106        int    numberofdofspernode;
     1107
     1108        /* gaussian points: */
     1109        int     num_area_gauss,igarea,igvert;
     1110        double* first_gauss_area_coord  =  NULL;
     1111        double* second_gauss_area_coord =  NULL;
     1112        double* third_gauss_area_coord  =  NULL;
     1113        double* vert_gauss_coord = NULL;
     1114        double* area_gauss_weights  =  NULL;
     1115        double* vert_gauss_weights  =  NULL;
     1116        double  gauss_weight,area_gauss_weight,vert_gauss_weight;
     1117        double  gauss_coord[4];
     1118        double  gauss_l1l2l3[3];
     1119
     1120        int area_order=5;
     1121        int num_vert_gauss=5;
     1122
     1123        int     dofs[3]={0,1,2};
     1124        double  dt;
     1125        double  K[2][2]={0.0};
     1126
     1127        double  vxvyvz_list[numgrids][3];
     1128        double  vx_list[numgrids];
     1129        int     vx_list_exists;
     1130        double  u;
     1131        double  vy_list[numgrids];
     1132        int     vy_list_exists;
     1133        double  v;
     1134        double  vz_list[numgrids];
     1135        int     vz_list_exists;
     1136        double  w;
     1137
     1138        /*matrices: */
     1139        double     K_terms[numdof][numdof]={0.0};
     1140        double     Ke_gaussian_conduct[numdof][numdof];
     1141        double     Ke_gaussian_advec[numdof][numdof];
     1142        double     Ke_gaussian_artdiff[numdof][numdof];
     1143        double     Ke_gaussian_transient[numdof][numdof];
     1144        double     B[3][numdof];
     1145        double     Bprime[3][numdof];
     1146        double     B_conduct[3][numdof];
     1147        double     B_advec[3][numdof];
     1148        double     B_artdiff[2][numdof];
     1149        double     Bprime_advec[3][numdof];
     1150        double     L[numdof];
     1151        double     D_scalar;
     1152        double     D[3][3];
     1153        double     l1l2l3[3];
     1154        double     tl1l2l3D[3];
     1155        double     tBD[3][numdof];
     1156        double     tBD_conduct[3][numdof];
     1157        double     tBD_advec[3][numdof];
     1158        double     tBD_artdiff[3][numdof];
     1159        double     tLD[numdof];
     1160
     1161        double     Jdet;
     1162
     1163        /*Material properties: */
     1164        double     gravity,rho_ice,rho_water;
     1165        double     heatcapacity,thermalconductivity;
     1166        double     mixed_layer_capacity,thermal_exchange_velocity;
     1167
     1168        /*Collapsed formulation: */
     1169        Tria*  tria=NULL;
     1170        ParameterInputs* inputs=NULL;
     1171
     1172        /*If on water, skip: */
     1173        if(onwater)return;
     1174
     1175        /*recover pointers: */
     1176        inputs=(ParameterInputs*)vinputs;
     1177
     1178        /* Get node coordinates and dof list: */
     1179        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     1180        GetDofList(&doflist[0],&numberofdofspernode);
     1181
     1182        // /*recovre material parameters: */
     1183        rho_water=matpar->GetRhoWater();
     1184        rho_ice=matpar->GetRhoIce();
     1185        gravity=matpar->GetG();
     1186        heatcapacity=matpar->GetHeatCapacity();
     1187        thermalconductivity=matpar->GetThermalConductivity();
     1188
     1189        /*recover extra inputs from users, dt and velocity: */
     1190        found=inputs->Recover("velocity",&vxvyvz_list[0][0],3,dofs,numgrids,(void**)nodes);
     1191        if(!found)throw ErrorException(__FUNCT__," could not find velocity in inputs!");
     1192        found=inputs->Recover("dt",&dt);
     1193        if(!found)throw ErrorException(__FUNCT__," could not find dt in inputs!");
     1194
     1195        for(i=0;i<numgrids;i++){
     1196                vx_list[i]=vxvyvz_list[i][0];
     1197                vy_list[i]=vxvyvz_list[i][1];
     1198                vz_list[i]=vxvyvz_list[i][2];
     1199        }
     1200
     1201
     1202        /* Get gaussian points and weights. Penta is an extrusion of a Tria, we therefore
     1203                get tria gaussian points as well as segment gaussian points. For tria gaussian
     1204                points, order of integration is 2, because we need to integrate the product tB*D*B'
     1205                which is a polynomial of degree 3 (see GaussTria for more details). For segment gaussian
     1206                points, same deal, which yields 3 gaussian points.: */
     1207
     1208        /*Get gaussian points: */
     1209        area_order=2;
     1210        num_vert_gauss=2;
     1211
     1212        GaussPenta( &num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &area_gauss_weights,&vert_gauss_coord, &vert_gauss_weights, area_order, num_vert_gauss);
     1213
     1214        /* Start  looping on the number of gaussian points: */
     1215        for (igarea=0; igarea<num_area_gauss; igarea++){
     1216                for (igvert=0; igvert<num_vert_gauss; igvert++){
     1217                        /*Pick up the gaussian point: */
     1218                        area_gauss_weight=*(area_gauss_weights+igarea);
     1219                        vert_gauss_weight=*(vert_gauss_weights+igvert);
     1220                        gauss_weight=area_gauss_weight*vert_gauss_weight;
     1221                        gauss_coord[0]=*(first_gauss_area_coord+igarea);
     1222                        gauss_coord[1]=*(second_gauss_area_coord+igarea);
     1223                        gauss_coord[2]=*(third_gauss_area_coord+igarea);
     1224                        gauss_coord[3]=*(vert_gauss_coord+igvert);
     1225
     1226                        /* Get Jacobian determinant: */
     1227                        GetJacobianDeterminant(&Jdet, &xyz_list[0][0],gauss_coord);
     1228
     1229                        /*Conduction: */
     1230
     1231                        /*Get B_conduct matrix: */
     1232                        GetB_conduct(&B_conduct[0][0],&xyz_list[0][0],gauss_coord);
     1233
     1234                        /*Build D: */
     1235                        D_scalar=gauss_weight*Jdet*(thermalconductivity/(rho_ice*heatcapacity));
     1236
     1237                        if(dt){
     1238                                D_scalar=D_scalar*dt;
     1239                        }
     1240
     1241                        D[0][0]=D_scalar; D[0][1]=0; D[0][2]=0;
     1242                        D[1][0]=0; D[1][1]=D_scalar; D[1][2]=0;
     1243                        D[2][0]=0; D[2][1]=0; D[2][2]=D_scalar;
     1244
     1245                        /*  Do the triple product B'*D*B: */
     1246                        MatrixMultiply(&B_conduct[0][0],3,numdof,1,&D[0][0],3,3,0,&tBD_conduct[0][0],0);
     1247                        MatrixMultiply(&tBD_conduct[0][0],numdof,3,0,&B_conduct[0][0],3,numdof,0,&Ke_gaussian_conduct[0][0],0);
     1248
     1249                        /*Advection: */
     1250
     1251                        /*Get B_advec and Bprime_advec matrices: */
     1252                        GetB_advec(&B_advec[0][0],&xyz_list[0][0],gauss_coord);
     1253                        GetBprime_advec(&Bprime_advec[0][0],&xyz_list[0][0],gauss_coord);
     1254
     1255                        //Build the D matrix
     1256                        GetParameterValue(&u, &vx_list[0],gauss_coord);
     1257                        GetParameterValue(&v, &vy_list[0],gauss_coord);
     1258                        GetParameterValue(&w, &vz_list[0],gauss_coord);
     1259
     1260                        D_scalar=gauss_weight*Jdet;
     1261
     1262                        if(dt){
     1263                                D_scalar=D_scalar*dt;
     1264                        }
     1265
     1266                        D[0][0]=D_scalar*u;D[0][1]=0;         D[0][2]=0;
     1267                        D[1][0]=0;         D[1][1]=D_scalar*v;D[1][2]=0;
     1268                        D[2][0]=0;         D[2][1]=0;         D[2][2]=D_scalar*w;
     1269
     1270                        /*  Do the triple product B'*D*Bprime: */
     1271                        MatrixMultiply(&B_advec[0][0],3,numdof,1,&D[0][0],3,3,0,&tBD_advec[0][0],0);
     1272                        MatrixMultiply(&tBD_advec[0][0],numdof,3,0,&Bprime_advec[0][0],3,numdof,0,&Ke_gaussian_advec[0][0],0);
     1273
     1274                        /*Transient: */
     1275                        if(dt){
     1276                                GetNodalFunctions(&L[0], gauss_coord);
     1277                                D_scalar=gauss_weight*Jdet;
     1278                                D_scalar=D_scalar;
     1279
     1280                                /*  Do the triple product L'*D*L: */
     1281                                MatrixMultiply(&L[0],numdof,1,0,&D_scalar,1,1,0,&tLD[0],0);
     1282                                MatrixMultiply(&tLD[0],numdof,1,0,&L[0],1,numdof,0,&Ke_gaussian_transient[0][0],0);
     1283                        }
     1284                        else{
     1285                                for(i=0;i<numdof;i++){
     1286                                        for(j=0;j<numdof;j++){
     1287                                                Ke_gaussian_transient[i][j]=0;
     1288                                        }
     1289                                }
     1290                        }
     1291
     1292                        /*Artifficial diffusivity*/
     1293                        if(numpar->artdiff){
     1294                                /*Build K: */
     1295                                D_scalar=gauss_weight*Jdet/(pow(u,2)+pow(v,2)+numpar->epsvel);
     1296                                if(dt){
     1297                                        D_scalar=D_scalar*dt;
     1298                                }
     1299                                K[0][0]=D_scalar*pow(u,2);       K[0][1]=D_scalar*fabs(u)*fabs(v);
     1300                                K[1][0]=D_scalar*fabs(u)*fabs(v);K[1][1]=D_scalar*pow(v,2);
     1301
     1302                                /*Get B_artdiff: */
     1303                                GetB_artdiff(&B_artdiff[0][0],&xyz_list[0][0],gauss_coord);
     1304
     1305                                /*  Do the triple product B'*K*B: */
     1306                                MatrixMultiply(&B_artdiff[0][0],2,numdof,1,&K[0][0],2,2,0,&tBD_artdiff[0][0],0);
     1307                                MatrixMultiply(&tBD_artdiff[0][0],numdof,2,0,&B_artdiff[0][0],2,numdof,0,&Ke_gaussian_artdiff[0][0],0);
     1308                        }
     1309                        else{
     1310                                for(i=0;i<numdof;i++){
     1311                                        for(j=0;j<numdof;j++){
     1312                                                Ke_gaussian_artdiff[i][j]=0;
     1313                                        }
     1314                                }
     1315                        }
     1316
     1317                        /*Add Ke_gaussian to pKe: */
     1318                        for(i=0;i<numdof;i++){
     1319                                for(j=0;j<numdof;j++){
     1320                                        K_terms[i][j]+=Ke_gaussian_conduct[i][j]+Ke_gaussian_advec[i][j]+Ke_gaussian_transient[i][j]+Ke_gaussian_artdiff[i][j];
     1321                                }
     1322                        }
     1323                }
     1324        }
     1325
     1326
     1327        /*Add Ke_gg to global matrix Kgg: */
     1328        MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)K_terms,ADD_VALUES);
     1329
     1330cleanup_and_return:
     1331        xfree((void**)&first_gauss_area_coord);
     1332        xfree((void**)&second_gauss_area_coord);
     1333        xfree((void**)&third_gauss_area_coord);
     1334        xfree((void**)&area_gauss_weights);
     1335        xfree((void**)&vert_gauss_weights);
     1336        xfree((void**)&vert_gauss_coord);
     1337
     1338        //Ice/ocean heat exchange flux on ice shelf base
     1339        if(onbed && shelf){
     1340
     1341                tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
     1342                tria->CreateKMatrixThermal(Kgg,inputs, analysis_type,sub_analysis_type);
     1343                delete tria;
     1344        }
     1345}
     1346/*}}}*/
     1347/*FUNCTION CreatePVector {{{1*/
    10711348#undef __FUNCT__
    10721349#define __FUNCT__ "Penta::CreatePVector"
    … …  
    11161393}
    11171394/*}}}*/
    1118 /*FUNCTION Penta UpdateFromInputs {{{1*/
    1119 #undef __FUNCT__
    1120 #define __FUNCT__ "Penta::UpdateFromInputs"
    1121 void  Penta::UpdateFromInputs(void* vinputs){
    1122 
    1123         int     dofs[1]={0};
    1124         double  temperature_list[6];
    1125         double  temperature_average;
    1126         double  B_list[6];
    1127         double  B_average;
    1128 
    1129         ParameterInputs* inputs=NULL;
    1130 
    1131         /*If on water, skip: */
    1132         if(onwater)return;
    1133 
    1134         /*recover pointers: */
    1135         inputs=(ParameterInputs*)vinputs;
    1136 
    1137         /*Update internal data if inputs holds new values: */
    1138         inputs->Recover("thickness",&h[0],1,dofs,6,(void**)nodes);
    1139         inputs->Recover("surface",&s[0],1,dofs,6,(void**)nodes);
    1140         inputs->Recover("bed",&b[0],1,dofs,6,(void**)nodes);
    1141         inputs->Recover("drag",&k[0],1,dofs,6,(void**)nodes);
    1142         inputs->Recover("melting",&melting[0],1,dofs,6,(void**)nodes);
    1143         inputs->Recover("accumulation_param",&accumulation[0],1,dofs,6,(void**)nodes);
    1144 
    1145         //Update material if necessary
    1146         if(inputs->Recover("temperature",&temperature_list[0],1,dofs,6,(void**)nodes)){
    1147                 if(matice && !collapse){
    1148                         //B_average=(Paterson(temperature_list[0])+Paterson(temperature_list[1])+Paterson(temperature_list[2])
    1149                         //                      +Paterson(temperature_list[3])+Paterson(temperature_list[4])+Paterson(temperature_list[5]))/6.0;
    1150                         temperature_average=(temperature_list[0]+temperature_list[1]+temperature_list[2]+temperature_list[3]+temperature_list[4]+temperature_list[5])/6.0;
    1151                         B_average=Paterson(temperature_average);
    1152                         matice->SetB(B_average);
    1153                 }
    1154         }
    1155 
    1156         if(inputs->Recover("temperature_average",&temperature_list[0],1,dofs,6,(void**)nodes)){
    1157                 if(matice && collapse){
    1158                         temperature_average=(temperature_list[0]+temperature_list[1]+temperature_list[2]+temperature_list[3]+temperature_list[4]+temperature_list[5])/6.0;
    1159                         B_average=Paterson(temperature_average);
    1160                         //B_average=(Paterson(temperature_list[0])+Paterson(temperature_list[1])+Paterson(temperature_list[2])
    1161                         //                      +Paterson(temperature_list[3])+Paterson(temperature_list[4])+Paterson(temperature_list[5]))/6.0;
    1162                         matice->SetB(B_average);
    1163                 }
    1164         }
    1165 
    1166         if(inputs->Recover("B",&B_list[0],1,dofs,6,(void**)nodes)){
    1167                 if(matice){
    1168                         B_average=(B_list[0]+B_list[1]+B_list[2]+B_list[3]+B_list[4]+B_list[5])/6.0;
    1169                         matice->SetB(B_average);
    1170                 }
    1171         }
    1172 
    1173 }
    1174 /*}}}*/
    1175 /*FUNCTION Penta GetMatPar {{{1*/
    1176 void* Penta::GetMatPar(){
    1177         return matpar;
    1178 }
    1179 /*}}}*/
    1180 /*FUNCTION Penta GetShelf {{{1*/
    1181 int   Penta::GetShelf(){
    1182         return shelf;
    1183 }
    1184 /*}}}*/
    1185 /*FUNCTION Penta GetNodes {{{1*/
    1186 void  Penta::GetNodes(void** vpnodes){
    1187         int i;
    1188         Node** pnodes=(Node**)vpnodes;
    1189 
    1190         for(i=0;i<6;i++){
    1191                 pnodes[i]=nodes[i];
    1192         }
    1193 }
    1194 /*}}}*/
    1195 /*FUNCTION Penta GetOnBed {{{1*/
    1196 int Penta::GetOnBed(){
    1197         return onbed;
    1198 }
    1199 /*}}}*/
    1200 /*FUNCTION Penta GetThicknessList {{{1*/
    1201 void Penta::GetThicknessList(double* thickness_list){
    1202 
    1203         int i;
    1204         for(i=0;i<6;i++)thickness_list[i]=h[i];
    1205 }
    1206 /*}}}*/
    1207 /*FUNCTION Penta GetBedList {{{1*/
    1208 void Penta::GetBedList(double* bed_list){
    1209 
    1210         int i;
    1211         for(i=0;i<6;i++)bed_list[i]=b[i];
    1212 
    1213 }
    1214 /*}}}*/
    1215 /*FUNCTION Penta copy {{{1*/
    1216 Object* Penta::copy() {
    1217         return new Penta(*this);
    1218 }
    1219 /*}}}*/
    1220 /*FUNCTION Penta Du {{{1*/
    1221 #undef __FUNCT__
    1222 #define __FUNCT__ "Penta::Du"
    1223 void  Penta::Du(Vec du_g,void* inputs,int analysis_type,int sub_analysis_type){
    1224 
    1225         int i;
    1226         Tria* tria=NULL;
    1227 
    1228         /*If on water, skip: */
    1229         if(onwater)return;
    1230 
    1231         /*Bail out if this element if:
    1232          * -> Non collapsed and not on the surface
    1233          * -> collapsed (2d model) and not on bed) */
    1234         if ((!collapse && !onsurface) || (collapse && !onbed)){
    1235                 return;
    1236         }
    1237         else if (collapse){
    1238 
    1239                 /*This element should be collapsed into a tria element at its base. Create this tria element,
    1240                  * and compute Du*/
    1241                 tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria (lower face).
    1242                 tria->Du(du_g,inputs,analysis_type,sub_analysis_type);
    1243                 delete tria;
    1244                 return;
    1245         }
    1246         else{
    1247 
    1248                 tria=(Tria*)SpawnTria(3,4,5); //grids 3, 4 and 5 make the new tria (upper face).
    1249                 tria->Du(du_g,inputs,analysis_type,sub_analysis_type);
    1250                 delete tria;
    1251                 return;
    1252         }
    1253 }
    1254 /*}}}*/
    1255 /*FUNCTION Penta Gradj {{{1*/
    1256 #undef __FUNCT__
    1257 #define __FUNCT__ "Penta::Gradj"
    1258 void  Penta::Gradj(Vec grad_g,void* inputs,int analysis_type,int sub_analysis_type,char* control_type){
    1259 
    1260         /*If on water, skip grad (=0): */
    1261         if(onwater)return;
    1262 
    1263         if (strcmp(control_type,"drag")==0){
    1264                 GradjDrag( grad_g,inputs,analysis_type,sub_analysis_type);
    1265         }
    1266         else if (strcmp(control_type,"B")==0){
    1267                 GradjB( grad_g, inputs,analysis_type,sub_analysis_type);
    1268         }
    1269         else throw ErrorException(__FUNCT__,exprintf("%s%s","control type not supported yet: ",control_type));
    1270 }
    1271 /*}}}*/
    1272 /*FUNCTION Penta GradjDrag {{{1*/
    1273 #undef __FUNCT__
    1274 #define __FUNCT__ "Penta::GradjDrag"
    1275 void  Penta::GradjDrag(Vec grad_g,void* inputs,int analysis_type,int sub_analysis_type){
    1276 
    1277         Tria* tria=NULL;
    1278 
    1279         /*If on water, skip: */
    1280         if(onwater)return;
    1281 
    1282         /*If on shelf, skip: */
    1283         if(shelf)return;
    1284 
    1285         /*Bail out if this element does not touch the bedrock: */
    1286         if (!onbed) return;
    1287 
    1288         if (sub_analysis_type==HorizAnalysisEnum()){
    1289 
    1290                 /*MacAyeal or Pattyn*/
    1291                 tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
    1292                 tria->GradjDrag( grad_g,inputs,analysis_type,sub_analysis_type);
    1293                 delete tria;
    1294                 return;
    1295         }
    1296         else if (sub_analysis_type==StokesAnalysisEnum()){
    1297 
    1298                 /*Stokes*/
    1299                 tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
    1300                 tria->GradjDragStokes( grad_g,inputs,analysis_type,sub_analysis_type);
    1301                 delete tria;
    1302                 return;
    1303         }
    1304         else throw ErrorException(__FUNCT__,exprintf("%s%i%s\n","sub_analysis: ",sub_analysis_type," not supported yet"));
    1305 }
    1306 /*}}}*/
    1307 /*FUNCTION Penta GradjB {{{1*/
    1308 #undef __FUNCT__
    1309 #define __FUNCT__ "Penta::GradjB"
    1310 void  Penta::GradjB(Vec grad_g,void* inputs,int analysis_type,int sub_analysis_type){
    1311 
    1312         Tria* tria=NULL;
    1313 
    1314         /*If on water, skip: */
    1315         if(onwater)return;
    1316 
    1317         if (collapse){
    1318                 /*Bail out element if collapsed (2d) and not on bed*/
    1319                 if (!onbed) return;
    1320 
    1321                 /*This element should be collapsed into a tria element at its base. Create this tria element,
    1322                  * and compute gardj*/
    1323                 tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria (lower face).
    1324                 tria->GradjB(grad_g,inputs,analysis_type,sub_analysis_type);
    1325                 delete tria;
    1326                 return;
    1327         }
    1328         else{
    1329                 /*B is a 2d field, use MacAyeal(2d) gradient even if it is Stokes or Pattyn*/
    1330                 tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria (lower face).
    1331                 tria->GradjB(grad_g,inputs,analysis_type,sub_analysis_type);
    1332                 delete tria;
    1333                 return;
    1334         }
    1335 }
    1336 /*}}}*/
    1337 /*FUNCTION Penta Misfit {{{1*/
    1338 #undef __FUNCT__
    1339 #define __FUNCT__ "Penta::Misfit"
    1340 double Penta::Misfit(void* inputs,int analysis_type,int sub_analysis_type){
    1341 
    1342         double J;
    1343         Tria* tria=NULL;
    1344 
    1345         /*If on water, return 0: */
    1346         if(onwater)return 0;
    1347 
    1348         /*Bail out if this element if:
    1349          * -> Non collapsed and not on the surface
    1350          * -> collapsed (2d model) and not on bed) */
    1351         if ((!collapse && !onsurface) || (collapse && !onbed)){
    1352                 return 0;
    1353         }
    1354         else if (collapse){
    1355 
    1356                 /*This element should be collapsed into a tria element at its base. Create this tria element,
    1357                  * and compute Misfit*/
    1358                 tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria (lower face).
    1359                 J=tria->Misfit(inputs,analysis_type,sub_analysis_type);
    1360                 delete tria;
    1361                 return J;
    1362         }
    1363         else{
    1364 
    1365                 tria=(Tria*)SpawnTria(3,4,5); //grids 3, 4 and 5 make the new tria (upper face).
    1366                 J=tria->Misfit(inputs,analysis_type,sub_analysis_type);
    1367                 delete tria;
    1368                 return J;
    1369         }
    1370 }
    1371 /*}}}*/
    1372 /*FUNCTION Penta SpawnTria {{{1*/
    1373 #undef __FUNCT__
    1374 #define __FUNCT__ "Penta::SpawnTria"
    1375 void*  Penta::SpawnTria(int g0, int g1, int g2){
    1376 
    1377         /*out of grids g0,g1 and g2 from Penta, build a tria element: */
    1378         Tria* tria=NULL;
    1379         double   tria_h[3];
    1380         double   tria_s[3];
    1381         double   tria_b[3];
    1382         double   tria_c[3];
    1383         double   tria_k[3];
    1384         double   tria_melting[3];
    1385         double   tria_accumulation[3];
    1386         double   tria_geothermalflux[3];
    1387 
    1388         /*configuration: */
    1389         int tria_node_ids[3];
    1390         Node* tria_nodes[3];
    1391         int tria_node_offsets[3];
    1392 
    1393         tria_h[0]=h[g0];
    1394         tria_h[1]=h[g1];
    1395         tria_h[2]=h[g2];
    1396 
    1397         tria_s[0]=s[g0];
    1398         tria_s[1]=s[g1];
    1399         tria_s[2]=s[g2];
    1400 
    1401         tria_b[0]=b[g0];
    1402         tria_b[1]=b[g1];
    1403         tria_b[2]=b[g2];
    1404 
    1405         tria_k[0]=k[g0];
    1406         tria_k[1]=k[g1];
    1407         tria_k[2]=k[g2];
    1408 
    1409         tria_melting[0]=melting[g0];
    1410         tria_melting[1]=melting[g1];
    1411         tria_melting[2]=melting[g2];
    1412 
    1413         tria_accumulation[0]=accumulation[g0];
    1414         tria_accumulation[1]=accumulation[g1];
    1415         tria_accumulation[2]=accumulation[g2];
    1416 
    1417         tria_geothermalflux[0]=geothermalflux[g0];
    1418         tria_geothermalflux[1]=geothermalflux[g1];
    1419         tria_geothermalflux[2]=geothermalflux[g2];
    1420 
    1421         tria_node_ids[0]=node_ids[g0];
    1422         tria_node_ids[1]=node_ids[g1];
    1423         tria_node_ids[2]=node_ids[g2];
    1424 
    1425         tria_nodes[0]=nodes[g0];
    1426         tria_nodes[1]=nodes[g1];
    1427         tria_nodes[2]=nodes[g2];
    1428 
    1429         tria_node_offsets[0]=node_offsets[g0];
    1430         tria_node_offsets[1]=node_offsets[g1];
    1431         tria_node_offsets[2]=node_offsets[g2];
    1432 
    1433         tria= new Tria(id,mid,mparid,numparid,tria_node_ids,tria_h,tria_s,tria_b,tria_k, tria_melting, tria_accumulation, tria_geothermalflux,friction_type,p,q,shelf,onwater);
    1434 
    1435         tria->NodeConfiguration(tria_node_ids,tria_nodes,tria_node_offsets);
    1436         tria->MaticeConfiguration(matice,matice_offset);
    1437         tria->MatparConfiguration(matpar,matpar_offset);
    1438         tria->NumparConfiguration(numpar,numpar_offset);
    1439 
    1440         return tria;
    1441 
    1442 }
    1443 /*}}}*/
    1444 /*FUNCTION Penta GetDofList {{{1*/
    1445 void  Penta::GetDofList(int* doflist,int* pnumberofdofspernode){
    1446 
    1447         int i,j;
    1448         int doflist_per_node[MAXDOFSPERNODE];
    1449         int numberofdofspernode;
    1450 
    1451         for(i=0;i<6;i++){
    1452                 nodes[i]->GetDofList(&doflist_per_node[0],&numberofdofspernode);
    1453                 for(j=0;j<numberofdofspernode;j++){
    1454                         doflist[i*numberofdofspernode+j]=doflist_per_node[j];
    1455                 }
    1456         }
    1457 
    1458         /*Assign output pointers:*/
    1459         *pnumberofdofspernode=numberofdofspernode;
    1460 
    1461 }
    1462 /*}}}*/
    1463 /*FUNCTION Penta GetDofList1 {{{1*/
    1464 void  Penta::GetDofList1(int* doflist){
    1465 
    1466         int i;
    1467         for(i=0;i<6;i++){
    1468                 doflist[i]=nodes[i]->GetDofList1();
    1469         }
    1470 
    1471 }
    1472 /*}}}*/
    1473 /*FUNCTION Penta GetStrainRate {{{1*/
    1474 #undef __FUNCT__
    1475 #define __FUNCT__ "Penta::GetStrainRate"
    1476 void Penta::GetStrainRate(double* epsilon, double* velocity, double* xyz_list, double* gauss_l1l2l3l4){
    1477 
    1478         int i;
    1479         const int numgrids=6;
    1480         const int NDOF2=2;
    1481 
    1482         double B[5][NDOF2*numgrids];
    1483 
    1484         /*Get B matrix: */
    1485         GetB(&B[0][0], xyz_list, gauss_l1l2l3l4);
    1486 
    1487 #ifdef _ISSM_DEBUG_
    1488         printf("B for grid1 : [ %lf   %lf  \n",B[0][0],B[0][1]);
    1489         printf("              [ %lf   %lf  \n",B[1][0],B[1][1]);
    1490         printf("              [ %lf   %lf  ]\n",B[2][0],B[2][1]);
    1491         printf("              [ %lf   %lf  ]\n",B[3][0],B[3][1]);
    1492         printf("              [ %lf   %lf  ]\n",B[4][0],B[4][1]);
    1493 
    1494         printf("B for grid2 : [ %lf   %lf  \n",B[0][2],B[0][3]);
    1495         printf("              [ %lf   %lf  \n",B[1][2],B[1][3]);
    1496         printf("              [ %lf   %lf  ]\n",B[2][2],B[2][3]);
    1497         printf("              [ %lf   %lf  ]\n",B[3][2],B[3][3]);
    1498         printf("              [ %lf   %lf  ]\n",B[4][2],B[4][3]);
    1499 
    1500         printf("B for grid3 : [ %lf   %lf  \n", B[0][4],B[0][5]);
    1501         printf("              [ %lf   %lf  \n", B[1][4],B[1][5]);
    1502         printf("              [ %lf   %lf  ]\n",B[2][4],B[2][5]);
    1503         printf("              [ %lf   %lf  ]\n",B[3][4],B[3][5]);
    1504         printf("              [ %lf   %lf  ]\n",B[4][4],B[4][5]);
    1505 
    1506         printf("B for grid4 : [ %lf   %lf  \n", B[0][6],B[0][7]);
    1507         printf("              [ %lf   %lf  \n", B[1][6],B[1][7]);
    1508         printf("              [ %lf   %lf  ]\n",B[2][6],B[2][7]);
    1509         printf("              [ %lf   %lf  ]\n",B[3][6],B[3][7]);
    1510         printf("              [ %lf   %lf  ]\n",B[4][6],B[4][7]);
    1511 
    1512         printf("B for grid5 : [ %lf   %lf  \n", B[0][8],B[0][9]);
    1513         printf("              [ %lf   %lf  \n", B[1][8],B[1][9]);
    1514         printf("              [ %lf   %lf  ]\n",B[2][8],B[2][9]);
    1515         printf("              [ %lf   %lf  ]\n",B[3][8],B[3][9]);
    1516         printf("              [ %lf   %lf  ]\n",B[4][8],B[4][9]);
    1517 
    1518         printf("B for grid6 : [ %lf   %lf  \n", B[0][10],B[0][11]);
    1519         printf("              [ %lf   %lf  \n", B[1][10],B[1][11]);
    1520         printf("              [ %lf   %lf  ]\n",B[2][10],B[2][11]);
    1521         printf("              [ %lf   %lf  ]\n",B[3][10],B[3][11]);
    1522         printf("              [ %lf   %lf  ]\n",B[4][10],B[4][11]);
    1523 
    1524 #endif
    1525 
    1526         /*Multiply B by velocity, to get strain rate: */
    1527         MatrixMultiply( &B[0][0],5,NDOF2*numgrids,0,
    1528                                 velocity,NDOF2*numgrids,1,0,
    1529                                 epsilon,0);
    1530 
    1531 }
    1532 /*}}}*/
    1533 /*FUNCTION Penta GetB {{{1*/
    1534 #undef __FUNCT__
    1535 #define __FUNCT__ "Penta::GetB"
    1536 void Penta::GetB(double* B, double* xyz_list, double* gauss_l1l2l3l4){
    1537 
    1538         /*Compute B  matrix. B=[B1 B2 B3 B4 B5 B6] where Bi is of size 5*NDOF2.
    1539          * For grid i, Bi can be expressed in the basic coordinate system
    1540          * by:
    1541          *       Bi_basic=[ dh/dx          0      ]
    1542          *                [   0           dh/dy   ]
    1543          *                [ 1/2*dh/dy  1/2*dh/dx  ]
    1544          *                [ 1/2*dh/dz      0      ]
    1545          *                [  0         1/2*dh/dz  ]
    1546          * where h is the interpolation function for grid i.
    1547          *
    1548          * We assume B has been allocated already, of size: 5x(NDOF2*numgrids)
    1549          */
    1550 
    1551         int i;
    1552         const int numgrids=6;
    1553         const int NDOF3=3;
    1554         const int NDOF2=2;
    1555 
    1556         double dh1dh2dh3dh4dh5dh6_basic[NDOF3][numgrids];
    1557 
    1558         /*Get dh1dh2dh3dh4dh5dh6_basic in basic coordinate system: */
    1559         GetNodalFunctionsDerivativesBasic(&dh1dh2dh3dh4dh5dh6_basic[0][0],xyz_list, gauss_l1l2l3l4);
    1560 
    1561 #ifdef _ISSM_DEBUG_
    1562         for (i=0;i<numgrids;i++){
    1563                 printf("Node %i  dh/dx=%lf dh/dy=%lf dh/dz=%lf\n",i,dh1dh2dh3dh4dh5dh6_basic[0][i],dh1dh2dh3dh4dh5dh6_basic[1][i],dh1dh2dh3dh4dh5dh6_basic[2][i]);
    1564         }
    1565 #endif
    1566 
    1567         /*Build B: */
    1568         for (i=0;i<numgrids;i++){
    1569                 *(B+NDOF2*numgrids*0+NDOF2*i)=dh1dh2dh3dh4dh5dh6_basic[0][i];
    1570                 *(B+NDOF2*numgrids*0+NDOF2*i+1)=0.0;
    1571 
    1572                 *(B+NDOF2*numgrids*1+NDOF2*i)=0.0;
    1573                 *(B+NDOF2*numgrids*1+NDOF2*i+1)=dh1dh2dh3dh4dh5dh6_basic[1][i];
    1574 
    1575                 *(B+NDOF2*numgrids*2+NDOF2*i)=(float).5*dh1dh2dh3dh4dh5dh6_basic[1][i];
    1576                 *(B+NDOF2*numgrids*2+NDOF2*i+1)=(float).5*dh1dh2dh3dh4dh5dh6_basic[0][i];
    1577 
    1578                 *(B+NDOF2*numgrids*3+NDOF2*i)=(float).5*dh1dh2dh3dh4dh5dh6_basic[2][i];
    1579                 *(B+NDOF2*numgrids*3+NDOF2*i+1)=0.0;
    1580 
    1581                 *(B+NDOF2*numgrids*4+NDOF2*i)=0.0;
    1582                 *(B+NDOF2*numgrids*4+NDOF2*i+1)=(float).5*dh1dh2dh3dh4dh5dh6_basic[2][i];
    1583         }
    1584 
    1585 }
    1586 /*}}}*/
    1587 /*FUNCTION Penta GetBPrime {{{1*/
    1588 #undef __FUNCT__
    1589 #define __FUNCT__ "Penta::GetBPrime"
    1590 void Penta::GetBPrime(double* B, double* xyz_list, double* gauss_l1l2l3l4){
    1591 
    1592         /*Compute B  prime matrix. B=[B1 B2 B3 B4 B5 B6] where Bi is of size 5*NDOF2.
    1593          * For grid i, Bi can be expressed in the basic coordinate system
    1594          * by:
    1595          *       Bi_basic=[ 2*dh/dx     dh/dy   ]
    1596          *                [   dh/dx    2*dh/dy  ]
    1597          *                [ dh/dy      dh/dx    ]
    1598          *                [ dh/dz         0     ]
    1599          *                [  0         dh/dz    ]
    1600          * where h is the interpolation function for grid i.
    1601          *
    1602          * We assume B has been allocated already, of size: 5x(NDOF2*numgrids)
    1603          */
    1604 
    1605         int i;
    1606         const int NDOF3=3;
    1607         const int NDOF2=2;
    1608         const int numgrids=6;
    1609 
    1610         double dh1dh2dh3dh4dh5dh6_basic[NDOF3][numgrids];
    1611 
    1612         /*Get dh1dh2dh3dh4dh5dh6_basic in basic coordinate system: */
    1613         GetNodalFunctionsDerivativesBasic(&dh1dh2dh3dh4dh5dh6_basic[0][0],xyz_list, gauss_l1l2l3l4);
    1614 
    1615 #ifdef _ISSM_DEBUG_
    1616         for (i=0;i<numgrids;i++){
    1617                 printf("Node %i  dh/dx=%lf dh/dy=%lf dh/dz=%lf\n",i,dh1dh2dh3dh4dh5dh6_basic[0][i],dh1dh2dh3dh4dh5dh6_basic[1][i],dh1dh2dh3dh4dh5dh6_basic[2][i]);
    1618         }
    1619 #endif
    1620 
    1621         /*Build BPrime: */
    1622         for (i=0;i<numgrids;i++){
    1623                 *(B+NDOF2*numgrids*0+NDOF2*i)=2.0*dh1dh2dh3dh4dh5dh6_basic[0][i];
    1624                 *(B+NDOF2*numgrids*0+NDOF2*i+1)=dh1dh2dh3dh4dh5dh6_basic[1][i];
    1625 
    1626                 *(B+NDOF2*numgrids*1+NDOF2*i)=dh1dh2dh3dh4dh5dh6_basic[0][i];
    1627                 *(B+NDOF2*numgrids*1+NDOF2*i+1)=2.0*dh1dh2dh3dh4dh5dh6_basic[1][i];
    1628 
    1629                 *(B+NDOF2*numgrids*2+NDOF2*i)=dh1dh2dh3dh4dh5dh6_basic[1][i];
    1630                 *(B+NDOF2*numgrids*2+NDOF2*i+1)=dh1dh2dh3dh4dh5dh6_basic[0][i];
    1631 
    1632                 *(B+NDOF2*numgrids*3+NDOF2*i)=dh1dh2dh3dh4dh5dh6_basic[2][i];
    1633                 *(B+NDOF2*numgrids*3+NDOF2*i+1)=0.0;
    1634 
    1635                 *(B+NDOF2*numgrids*4+NDOF2*i)=0.0;
    1636                 *(B+NDOF2*numgrids*4+NDOF2*i+1)=dh1dh2dh3dh4dh5dh6_basic[2][i];
    1637         }
    1638 }
    1639 /*}}}*/
    1640 /*FUNCTION Penta GetJacobianDeterminant {{{1*/
    1641 #undef __FUNCT__
    1642 #define __FUNCT__ "Penta::GetJacobianDeterminant"
    1643 void Penta::GetJacobianDeterminant(double*  Jdet, double* xyz_list,double* gauss_l1l2l3l4){
    1644 
    1645         /*On a penta, Jacobian varies according to coordinates. We need to get the Jacobian, and take
    1646          * the determinant of it: */
    1647         const int NDOF3=3;
    1648 
    1649         double J[NDOF3][NDOF3];
    1650 
    1651         GetJacobian(&J[0][0],xyz_list,gauss_l1l2l3l4);
    1652 
    1653         *Jdet= J[0][0]*J[1][1]*J[2][2]-J[0][0]*J[1][2]*J[2][1]-J[1][0]*J[0][1]*J[2][2]+J[1][0]*J[0][2]*J[2][1]+J[2][0]*J[0][1]*J[1][2]-J[2][0]*J[0][2]*J[1][1];
    1654         if(*Jdet<0){
    1655                 printf("%s%s%i\n",__FUNCT__," error message: negative jacobian determinant on element ",id);
    1656         }
    1657 }
    1658 /*}}}*/
    1659 /*FUNCTION Penta GetNodalFunctionsDerivativesBasic {{{1*/
    1660 #undef __FUNCT__
    1661 #define __FUNCT__ "Penta::GetNodalFunctionsDerivativesBasic"
    1662 void Penta::GetNodalFunctionsDerivativesBasic(double* dh1dh2dh3dh4dh5dh6_basic,double* xyz_list, double* gauss_l1l2l3l4){
    1663 
    1664         /*This routine returns the values of the nodal functions derivatives  (with respect to the basic coordinate system: */
    1665 
    1666 
    1667         int i;
    1668         const int NDOF3=3;
    1669         const int numgrids=6;
    1670 
    1671         double dh1dh2dh3dh4dh5dh6_param[NDOF3][numgrids];
    1672         double Jinv[NDOF3][NDOF3];
    1673 
    1674         /*Get derivative values with respect to parametric coordinate system: */
    1675         GetNodalFunctionsDerivativesParams(&dh1dh2dh3dh4dh5dh6_param[0][0], gauss_l1l2l3l4);
    1676 
    1677         /*Get Jacobian invert: */
    1678         GetJacobianInvert(&Jinv[0][0], xyz_list, gauss_l1l2l3l4);
    1679 
    1680         /*Build dh1dh2dh3_basic:
    1681          *
    1682          * [dhi/dx]= Jinv*[dhi/dr]
    1683          * [dhi/dy]       [dhi/ds]
    1684          * [dhi/dz]       [dhi/dn]
    1685          */
    1686 
    1687         for (i=0;i<numgrids;i++){
    1688                 *(dh1dh2dh3dh4dh5dh6_basic+numgrids*0+i)=Jinv[0][0]*dh1dh2dh3dh4dh5dh6_param[0][i]+Jinv[0][1]*dh1dh2dh3dh4dh5dh6_param[1][i]+Jinv[0][2]*dh1dh2dh3dh4dh5dh6_param[2][i];
    1689                 *(dh1dh2dh3dh4dh5dh6_basic+numgrids*1+i)=Jinv[1][0]*dh1dh2dh3dh4dh5dh6_param[0][i]+Jinv[1][1]*dh1dh2dh3dh4dh5dh6_param[1][i]+Jinv[1][2]*dh1dh2dh3dh4dh5dh6_param[2][i];
    1690                 *(dh1dh2dh3dh4dh5dh6_basic+numgrids*2+i)=Jinv[2][0]*dh1dh2dh3dh4dh5dh6_param[0][i]+Jinv[2][1]*dh1dh2dh3dh4dh5dh6_param[1][i]+Jinv[2][2]*dh1dh2dh3dh4dh5dh6_param[2][i];
    1691         }
    1692 
    1693 }
    1694 /*}}}*/
    1695 /*FUNCTION Penta GetJacobian {{{1*/
    1696 #undef __FUNCT__
    1697 #define __FUNCT__ "Penta::GetJacobian"
    1698 void Penta::GetJacobian(double* J, double* xyz_list,double* gauss_l1l2l3l4){
    1699 
    1700         const int NDOF3=3;
    1701         int i,j;
    1702 
    1703         /*The Jacobian is constant over the element, discard the gaussian points.
    1704          * J is assumed to have been allocated of size NDOF2xNDOF2.*/
    1705 
    1706         double A1,A2,A3; //area coordinates
    1707         double xi,eta,zi; //parametric coordinates
    1708 
    1709         double x1,x2,x3,x4,x5,x6;
    1710         double y1,y2,y3,y4,y5,y6;
    1711         double z1,z2,z3,z4,z5,z6;
    1712 
    1713         double sqrt3=sqrt(3.0);
    1714 
    1715         /*Figure out xi,eta and zi (parametric coordinates), for this gaussian point: */
    1716         A1=gauss_l1l2l3l4[0];
    1717         A2=gauss_l1l2l3l4[1];
    1718         A3=gauss_l1l2l3l4[2];
    1719 
    1720         xi=A2-A1;
    1721         eta=sqrt3*A3;
    1722         zi=gauss_l1l2l3l4[3];
    1723 
    1724         x1=*(xyz_list+3*0+0);
    1725         x2=*(xyz_list+3*1+0);
    1726         x3=*(xyz_list+3*2+0);
    1727         x4=*(xyz_list+3*3+0);
    1728         x5=*(xyz_list+3*4+0);
    1729         x6=*(xyz_list+3*5+0);
    1730 
    1731         y1=*(xyz_list+3*0+1);
    1732         y2=*(xyz_list+3*1+1);
    1733         y3=*(xyz_list+3*2+1);
    1734         y4=*(xyz_list+3*3+1);
    1735         y5=*(xyz_list+3*4+1);
    1736         y6=*(xyz_list+3*5+1);
    1737 
    1738         z1=*(xyz_list+3*0+2);
    1739         z2=*(xyz_list+3*1+2);
    1740         z3=*(xyz_list+3*2+2);
    1741         z4=*(xyz_list+3*3+2);
    1742         z5=*(xyz_list+3*4+2);
    1743         z6=*(xyz_list+3*5+2);
    1744 
    1745 
    1746         *(J+NDOF3*0+0)=1.0/4.0*(x1-x2-x4+x5)*zi+1.0/4.0*(-x1+x2-x4+x5);
    1747         *(J+NDOF3*1+0)=sqrt3/12.0*(x1+x2-2*x3-x4-x5+2*x6)*zi+sqrt3/12.0*(-x1-x2+2*x3-x4-x5+2*x6);
    1748         *(J+NDOF3*2+0)=sqrt3/12.0*(x1+x2-2*x3-x4-x5+2*x6)*eta+1/4*(x1-x2-x4+x5)*xi +1.0/4.0*(-x1+x5-x2+x4);
    1749 
    1750         *(J+NDOF3*0+1)=1.0/4.0*(y1-y2-y4+y5)*zi+1.0/4.0*(-y1+y2-y4+y5);
    1751         *(J+NDOF3*1+1)=sqrt3/12.0*(y1+y2-2*y3-y4-y5+2*y6)*zi+sqrt3/12.0*(-y1-y2+2*y3-y4-y5+2*y6);
    1752         *(J+NDOF3*2+1)=sqrt3/12.0*(y1+y2-2*y3-y4-y5+2*y6)*eta+1.0/4.0*(y1-y2-y4+y5)*xi+1.0/4.0*(y4-y1+y5-y2);
    1753 
    1754         *(J+NDOF3*0+2)=1.0/4.0*(z1-z2-z4+z5)*zi+1.0/4.0*(-z1+z2-z4+z5);
    1755         *(J+NDOF3*1+2)=sqrt3/12.0*(z1+z2-2*z3-z4-z5+2*z6)*zi+sqrt3/12.0*(-z1-z2+2*z3-z4-z5+2*z6);
    1756         *(J+NDOF3*2+2)=sqrt3/12.0*(z1+z2-2*z3-z4-z5+2*z6)*eta+1.0/4.0*(z1-z2-z4+z5)*xi+1.0/4.0*(-z1+z5-z2+z4);
    1757 
    1758 #ifdef _ISSM_DEBUG_
    1759         for(i=0;i<3;i++){
    1760                 for (j=0;j<3;j++){
    1761                         printf("%lf ",*(J+NDOF3*i+j));
    1762                 }
    1763                 printf("\n");
    1764         }
    1765 #endif
    1766 }
    1767 /*}}}*/
    1768 /*FUNCTION Penta GetNodalFunctionsDerivativesParams {{{1*/
    1769 #undef __FUNCT__
    1770 #define __FUNCT__ "Penta::GetNodalFunctionsDerivativesParams"
    1771 void Penta::GetNodalFunctionsDerivativesParams(double* dl1dl2dl3dl4dl5dl6,double* gauss_l1l2l3l4){
    1772 
    1773         /*This routine returns the values of the nodal functions derivatives  (with respect to the
    1774          * natural coordinate system) at the gaussian point. Those values vary along xi,eta,z */
    1775 
    1776         const int numgrids=6;
    1777         double A1,A2,A3,z;
    1778         double sqrt3=sqrt(3.0);
    1779 
    1780         A1=gauss_l1l2l3l4[0]; //first area coordinate value. In term of xi and eta: A1=(1-xi)/2-eta/(2*sqrt(3));
    1781         A2=gauss_l1l2l3l4[1]; //second area coordinate value In term of xi and eta: A2=(1+xi)/2-eta/(2*sqrt(3));
    1782         A3=gauss_l1l2l3l4[2]; //third area coordinate value  In term of xi and eta: A3=y/sqrt(3);
    1783         z=gauss_l1l2l3l4[3]; //fourth vertical coordinate value. Corresponding nodal function: (1-z)/2 and (1+z)/2
    1784 
    1785 
    1786         /*First nodal function derivatives. The corresponding nodal function is N=A1*(1-z)/2. Its derivatives follow*/
    1787         *(dl1dl2dl3dl4dl5dl6+numgrids*0+0)=-1.0/2.0*(1.0-z)/2.0;
    1788         *(dl1dl2dl3dl4dl5dl6+numgrids*1+0)=-1.0/2.0/sqrt3*(1.0-z)/2.0;
    1789         *(dl1dl2dl3dl4dl5dl6+numgrids*2+0)=-1.0/2.0*A1;
    1790 
    1791         /*Second nodal function: The corresponding nodal function is N=A2*(1-z)/2. Its derivatives follow*/
    1792         *(dl1dl2dl3dl4dl5dl6+numgrids*0+1)=1.0/2.0*(1.0-z)/2.0;
    1793         *(dl1dl2dl3dl4dl5dl6+numgrids*1+1)=-1.0/2.0/sqrt3*(1.0-z)/2.0;
    1794         *(dl1dl2dl3dl4dl5dl6+numgrids*2+1)=-1.0/2.0*A2;
    1795 
    1796         /*Third nodal function: The corresponding nodal function is N=A3*(1-z)/2. Its derivatives follow*/
    1797         *(dl1dl2dl3dl4dl5dl6+numgrids*0+2)=0.0;
    1798         *(dl1dl2dl3dl4dl5dl6+numgrids*1+2)=1.0/sqrt3*(1.0-z)/2.0;
    1799         *(dl1dl2dl3dl4dl5dl6+numgrids*2+2)=-1.0/2.0*A3;
    1800 
    1801         /*Fourth nodal function: The corresponding nodal function is N=A1*(1+z)/2. Its derivatives follow*/
    1802         *(dl1dl2dl3dl4dl5dl6+numgrids*0+3)=-1.0/2.0*(1.0+z)/2.0;
    1803         *(dl1dl2dl3dl4dl5dl6+numgrids*1+3)=-1.0/2.0/sqrt3*(1.0+z)/2.0;
    1804         *(dl1dl2dl3dl4dl5dl6+numgrids*2+3)=1.0/2.0*A1;
    1805 
    1806         /*Fifth nodal function: The corresponding nodal function is N=A2*(1+z)/2. Its derivatives follow*/
    1807         *(dl1dl2dl3dl4dl5dl6+numgrids*0+4)=1.0/2.0*(1.0+z)/2.0;
    1808         *(dl1dl2dl3dl4dl5dl6+numgrids*1+4)=-1.0/2.0/sqrt3*(1.0+z)/2.0;
    1809         *(dl1dl2dl3dl4dl5dl6+numgrids*2+4)=1.0/2.0*A2;
    1810 
    1811         /*Sixth nodal function: The corresponding nodal function is N=A3*(1+z)/2. Its derivatives follow*/
    1812         *(dl1dl2dl3dl4dl5dl6+numgrids*0+5)=0.0;
    1813         *(dl1dl2dl3dl4dl5dl6+numgrids*1+5)=1.0/sqrt3*(1.0+z)/2.0;
    1814         *(dl1dl2dl3dl4dl5dl6+numgrids*2+5)=1.0/2.0*A3;
    1815 }
    1816 /*}}}*/
    1817 /*FUNCTION Penta GetJacobianInvert {{{1*/
    1818 #undef __FUNCT__
    1819 #define __FUNCT__ "Penta::GetJacobianInvert"
    1820 void Penta::GetJacobianInvert(double*  Jinv, double* xyz_list,double* gauss_l1l2l3l4){
    1821 
    1822         double Jdet;
    1823         const int NDOF3=3;
    1824 
    1825         /*Call Jacobian routine to get the jacobian:*/
    1826         GetJacobian(Jinv, xyz_list, gauss_l1l2l3l4);
    1827 
    1828         /*Invert Jacobian matrix: */
    1829         MatrixInverse(Jinv,NDOF3,NDOF3,NULL,0,&Jdet);
    1830 }
    1831 /*}}}*/
    1832 /*FUNCTION Penta CreatePVectorDiagnosticHoriz {{{1*/
     1395/*FUNCTION CreatePVectorDiagnosticHoriz {{{1*/
    18331396#undef __FUNCT__
    18341397#define __FUNCT__ "Penta::CreatePVectorDiagnosticHoriz"
    … …  
    19881551}
    19891552/*}}}*/
    1990 /*FUNCTION Penta GetParameterValue {{{1*/
    1991 #undef __FUNCT__
    1992 #define __FUNCT__ "Penta::GetParameterValue"
    1993 void Penta::GetParameterValue(double* pvalue, double* v_list,double* gauss_l1l2l3l4){
     1553/*FUNCTION CreatePVectorDiagnosticStokes {{{1*/
     1554#undef __FUNCT__
     1555#define __FUNCT__ "Penta::CreatePVectorDiagnosticStokes"
     1556void Penta::CreatePVectorDiagnosticStokes( Vec pg, void* vinputs,int analysis_type,int sub_analysis_type){
     1557
     1558        /*indexing: */
     1559        int i,j;
    19941560
    19951561        const int numgrids=6;
    1996         double l1l2l3l4l5l6[numgrids];
    1997 
    1998         GetNodalFunctions(&l1l2l3l4l5l6[0], gauss_l1l2l3l4);
    1999 
    2000         *pvalue=l1l2l3l4l5l6[0]*v_list[0]+l1l2l3l4l5l6[1]*v_list[1]+l1l2l3l4l5l6[2]*v_list[2]+l1l2l3l4l5l6[3]*v_list[3]+l1l2l3l4l5l6[4]*v_list[4]+l1l2l3l4l5l6[5]*v_list[5];
    2001 }
    2002 /*}}}*/
    2003 /*FUNCTION Penta GetParameterDerivativeValue {{{1*/
    2004 #undef __FUNCT__
    2005 #define __FUNCT__ "Penta::GetParameterDerivativeValue"
    2006 void Penta::GetParameterDerivativeValue(double* p, double* p_list,double* xyz_list, double* gauss_l1l2l3l4){
    2007 
    2008         /*From grid values of parameter p (p_list[0], p_list[1], p_list[2], p_list[3], p_list[4] and p_list[4]), return parameter derivative value at gaussian point specified by gauss_l1l2l3l4:
    2009          *   dp/dx=p_list[0]*dh1/dx+p_list[1]*dh2/dx+p_list[2]*dh3/dx+p_list[3]*dh4/dx+p_list[4]*dh5/dx+p_list[5]*dh6/dx;
    2010          *   dp/dy=p_list[0]*dh1/dy+p_list[1]*dh2/dy+p_list[2]*dh3/dy+p_list[3]*dh4/dy+p_list[4]*dh5/dy+p_list[5]*dh6/dy;
    2011          *   dp/dz=p_list[0]*dh1/dz+p_list[1]*dh2/dz+p_list[2]*dh3/dz+p_list[3]*dh4/dz+p_list[4]*dh5/dz+p_list[5]*dh6/dz;
    2012          *
    2013          *   p is a vector of size 3x1 already allocated.
    2014          */
    2015 
    2016         const int NDOF3=3;
    2017         const int numgrids=6;
    2018         double dh1dh2dh3dh4dh5dh6_basic[NDOF3][numgrids];
    2019 
    2020         /*Get dh1dh2dh3dh4dh5dh6_basic in basic coordinate system: */
    2021         GetNodalFunctionsDerivativesBasic(&dh1dh2dh3dh4dh5dh6_basic[0][0],xyz_list, gauss_l1l2l3l4);
    2022 
    2023         *(p+0)=p_list[0]*dh1dh2dh3dh4dh5dh6_basic[0][0]+p_list[1]*dh1dh2dh3dh4dh5dh6_basic[0][1]+p_list[2]*dh1dh2dh3dh4dh5dh6_basic[0][2]+p_list[3]*dh1dh2dh3dh4dh5dh6_basic[0][3]+p_list[4]*dh1dh2dh3dh4dh5dh6_basic[0][4]+p_list[5]*dh1dh2dh3dh4dh5dh6_basic[0][5];
    2024         ;
    2025         *(p+1)=p_list[0]*dh1dh2dh3dh4dh5dh6_basic[1][0]+p_list[1]*dh1dh2dh3dh4dh5dh6_basic[1][1]+p_list[2]*dh1dh2dh3dh4dh5dh6_basic[1][2]+p_list[3]*dh1dh2dh3dh4dh5dh6_basic[1][3]+p_list[4]*dh1dh2dh3dh4dh5dh6_basic[1][4]+p_list[5]*dh1dh2dh3dh4dh5dh6_basic[1][5];
    2026 
    2027         *(p+2)=p_list[0]*dh1dh2dh3dh4dh5dh6_basic[2][0]+p_list[1]*dh1dh2dh3dh4dh5dh6_basic[2][1]+p_list[2]*dh1dh2dh3dh4dh5dh6_basic[2][2]+p_list[3]*dh1dh2dh3dh4dh5dh6_basic[2][3]+p_list[4]*dh1dh2dh3dh4dh5dh6_basic[2][4]+p_list[5]*dh1dh2dh3dh4dh5dh6_basic[2][5];
    2028 
    2029 }
    2030 /*}}}*/
    2031 /*FUNCTION Penta GetNodalFunctions {{{1*/
    2032 #undef __FUNCT__
    2033 #define __FUNCT__ "Penta::GetNodalFunctions"
    2034 void Penta::GetNodalFunctions(double* l1l2l3l4l5l6, double* gauss_l1l2l3l4){
    2035 
    2036         /*This routine returns the values of the nodal functions  at the gaussian point.*/
    2037 
    2038         l1l2l3l4l5l6[0]=gauss_l1l2l3l4[0]*(1-gauss_l1l2l3l4[3])/2.0;
    2039 
    2040         l1l2l3l4l5l6[1]=gauss_l1l2l3l4[1]*(1-gauss_l1l2l3l4[3])/2.0;
    2041 
    2042         l1l2l3l4l5l6[2]=gauss_l1l2l3l4[2]*(1-gauss_l1l2l3l4[3])/2.0;
    2043 
    2044         l1l2l3l4l5l6[3]=gauss_l1l2l3l4[0]*(1+gauss_l1l2l3l4[3])/2.0;
    2045 
    2046         l1l2l3l4l5l6[4]=gauss_l1l2l3l4[1]*(1+gauss_l1l2l3l4[3])/2.0;
    2047 
    2048         l1l2l3l4l5l6[5]=gauss_l1l2l3l4[2]*(1+gauss_l1l2l3l4[3])/2.0;
    2049 
    2050 }
    2051 /*}}}*/
    2052 /*FUNCTION Penta FieldExtrude {{{1*/
    2053 #undef __FUNCT__
    2054 #define __FUNCT__ "Penta::FieldExtrude"
    2055 void  Penta::FieldExtrude(Vec field,double* field_serial,char* field_name, int iscollapsed){
    2056 
    2057         /* node data: */
    2058         const int    numgrids=6;
    2059         int          numberofdofspernode;
    2060         Node* node=NULL;
    2061         int   i;
    2062         int   extrude=0;
    2063 
    2064         /*Figure out if we should extrude for this element: */
    2065         if (iscollapsed){
    2066                 /*From higher level, we are told to extrude only elements that have the collapse flag on: */
    2067                 if (collapse)extrude=1;
    2068                 else extrude=0;
    2069         }
    2070         else{
    2071                 /*From higher level, we are told to extrude all elements: */
    2072                 extrude=1;
    2073         }
    2074 
    2075         /*Now, extrusion starts from the bed on, so double check this element is on
    2076          * the bedrock: */
    2077         if(onbed==0)extrude=0;
    2078 
    2079         /*Go on and extrude field: */
    2080         if (extrude){
    2081 
    2082                 if (strcmp(field_name,"velocity")==0){
    2083 
    2084                         /* node data: */
    2085                         const int    numdof=2*numgrids;
    2086                         int          doflist[numdof];
    2087                         int          nodedofs[2];
    2088                         double       fieldel[2];
    2089 
    2090 
    2091                         GetDofList(&doflist[0],&numberofdofspernode);
    2092 
    2093                         /*this penta is a collapsed macayeal. For each node on the base of this penta,
    2094                          * we grab the field. Once we know the field, we follow the upper nodes,
    2095                          * inserting the same field value into field, until we reach the surface: */
    2096                         for(i=0;i<3;i++){
    2097 
    2098                                 node=nodes[i]; //base nodes
    2099 
    2100                                 /*get field for this base node: */
    2101                                 fieldel[0]=field_serial[doflist[numberofdofspernode*i+0]];
    2102                                 fieldel[1]=field_serial[doflist[numberofdofspernode*i+1]];
    2103 
    2104                                 //go throfieldn all nodes which sit on top of this node, until we reach the surface,
    2105                                 //and plfield  field in field
    2106                                 for(;;){
    2107 
    2108                                         node->GetDofList(&nodedofs[0],&numberofdofspernode);
    2109                                         VecSetValues(field,1,&nodedofs[0],&fieldel[0],INSERT_VALUES);
    2110                                         VecSetValues(field,1,&nodedofs[1],&fieldel[1],INSERT_VALUES);
    2111 
    2112                                         if (node->IsOnSurface())break;
    2113                                         /*get next node: */
    2114                                         node=node->GetUpperNode();
     1562        const int DOFPERGRID=4;
     1563        const int numdof=numgrids*DOFPERGRID;
     1564        const int numgrids2d=3;
     1565        int numdof2d=numgrids2d*DOFPERGRID;
     1566        int doflist[numdof];
     1567        int numberofdofspernode;
     1568
     1569        /*Material properties: */
     1570        double         gravity,rho_ice,rho_water;
     1571
     1572        /*parameters: */
     1573        double             xyz_list_tria[numgrids2d][3];
     1574        double         xyz_list[numgrids][3];
     1575        double             surface_normal[3];
     1576        double             bed_normal[3];
     1577        double         bed;
     1578        double         vxvyvz_list[numgrids][3];
     1579
     1580        /* gaussian points: */
     1581        int     num_area_gauss;
     1582        int     igarea,igvert;
     1583        double* first_gauss_area_coord  =  NULL;
     1584        double* second_gauss_area_coord =  NULL;
     1585        double* third_gauss_area_coord  =  NULL;
     1586        double* vert_gauss_coord = NULL;
     1587        double* area_gauss_weights  =  NULL;
     1588        double* vert_gauss_weights  =  NULL;
     1589
     1590        /* specific gaussian point: */
     1591        double  gauss_weight,area_gauss_weight,vert_gauss_weight;
     1592        double  gauss_coord[4];
     1593        double  gauss_coord_tria[3];
     1594
     1595        int     area_order=5;
     1596        int       num_vert_gauss=5;
     1597
     1598        double  epsilon[6]; /* epsilon=[exx,eyy,ezz,exy,exz,eyz];*/
     1599        double  viscosity;
     1600        double  water_pressure;
     1601        int     dofs[3]={0,1,2};
     1602
     1603        /*matrices: */
     1604        double     Pe_temp[27]={0.0}; //for the six nodes and the bubble
     1605        double     Pe_gaussian[27]={0.0}; //for the six nodes and the bubble
     1606        double     Ke_temp[27][3]={0.0}; //for the six nodes and the bubble
     1607        double     Pe_reduced[numdof]; //for the six nodes only
     1608        double     Ke_gaussian[27][3];
     1609        double     L[3]; //for the three nodes of the bed
     1610        double     l1l7[7]; //for the six nodes and the bubble
     1611        double     B[8][27];
     1612        double     B_prime[8][27];
     1613        double     B_prime_bubble[8][3];
     1614        double     Jdet;
     1615        double     Jdet2d;
     1616        double     D[8][8]={0.0};
     1617        double     D_scalar;
     1618        double     tBD[27][8];
     1619        double     P_terms[numdof];
     1620
     1621        ParameterInputs* inputs=NULL;
     1622        Tria*            tria=NULL;
     1623
     1624        /*If on water, skip load: */
     1625        if(onwater)return;
     1626
     1627        /*recover pointers: */
     1628        inputs=(ParameterInputs*)vinputs;
     1629
     1630        /* Set P_terms to 0: */
     1631        for(i=0;i<numdof;i++){
     1632                P_terms[i]=0;
     1633        }       
     1634
     1635        /*recovre material parameters: */
     1636        rho_water=matpar->GetRhoWater();
     1637        rho_ice=matpar->GetRhoIce();
     1638        gravity=matpar->GetG();
     1639
     1640        /*recover extra inputs from users, at current convergence iteration: */
     1641        inputs->Recover("velocity",&vxvyvz_list[0][0],3,dofs,numgrids,(void**)nodes);
     1642
     1643        /* Get node coordinates and dof list: */
     1644        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     1645        GetDofList(&doflist[0],&numberofdofspernode);
     1646
     1647        /* Get gaussian points and weights. Penta is an extrusion of a Tria, we therefore
     1648                get tria gaussian points as well as segment gaussian points. For tria gaussian
     1649                points, order of integration is 2, because we need to integrate the product tB*D*B'
     1650                which is a polynomial of degree 3 (see GaussTria for more details). For segment gaussian
     1651                points, same deal, which yields 3 gaussian points.*/
     1652
     1653        /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
     1654        GaussPenta( &num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &area_gauss_weights,&vert_gauss_coord, &vert_gauss_weights, area_order, num_vert_gauss);
     1655
     1656        /* Start  looping on the number of gaussian points: */
     1657        for (igarea=0; igarea<num_area_gauss; igarea++){
     1658                for (igvert=0; igvert<num_vert_gauss; igvert++){
     1659                        /*Pick up the gaussian point: */
     1660                        area_gauss_weight=*(area_gauss_weights+igarea);
     1661                        vert_gauss_weight=*(vert_gauss_weights+igvert);
     1662                        gauss_weight=area_gauss_weight*vert_gauss_weight;
     1663                        gauss_coord[0]=*(first_gauss_area_coord+igarea);
     1664                        gauss_coord[1]=*(second_gauss_area_coord+igarea);
     1665                        gauss_coord[2]=*(third_gauss_area_coord+igarea);
     1666                        gauss_coord[3]=*(vert_gauss_coord+igvert);
     1667
     1668                        /*Compute strain rate and viscosity: */
     1669                        GetStrainRateStokes(&epsilon[0],&vxvyvz_list[0][0],&xyz_list[0][0],gauss_coord);
     1670                        matice->GetViscosity3dStokes(&viscosity,&epsilon[0]);
     1671
     1672                        /* Get Jacobian determinant: */
     1673                        GetJacobianDeterminant(&Jdet, &xyz_list[0][0],gauss_coord);
     1674
     1675                        /* Get nodal functions */
     1676                        GetNodalFunctionsStokes(&l1l7[0], gauss_coord);
     1677
     1678                        /* Build gaussian vector */
     1679                        for(i=0;i<numgrids+1;i++){
     1680                                Pe_gaussian[i*DOFPERGRID+2]=-rho_ice*gravity*Jdet*gauss_weight*l1l7[i];
     1681                        }
     1682
     1683                        /*Add Pe_gaussian to terms in Pe_temp. Watch out for column orientation from matlab: */
     1684                        for(i=0;i<27;i++){
     1685                                Pe_temp[i]+=Pe_gaussian[i];
     1686                        }
     1687
     1688                        /*Get B and Bprime matrices: */
     1689                        GetBStokes(&B[0][0],&xyz_list[0][0],gauss_coord);
     1690                        GetBprimeStokes(&B_prime[0][0],&xyz_list[0][0], gauss_coord);
     1691
     1692                        /*Get bubble part of Bprime */
     1693                        for(i=0;i<8;i++){
     1694                                for(j=0;j<3;j++){
     1695                                        B_prime_bubble[i][j]=B_prime[i][j+24];
    21151696                                }
    21161697                        }
    2117                 } //if (strcmp(field_name,"velocity")==0)
    2118                 else if (strcmp(field_name,"gradj")==0){
    2119 
    2120                         /* node data: */
    2121                         int          dof1;
    2122                         double       fieldel;
    2123 
    2124                         /*this penta is a collapsed macayeal. For each node on the base of this penta,
    2125                          * we grab the field. Once we know the field, we follow the upper nodes,
    2126                          * inserting the same field value into field, until we reach the surface: */
    2127                         for(i=0;i<3;i++){
    2128 
    2129                                 node=nodes[i]; //base nodes
    2130                                 dof1=node->GetDofList1();
    2131 
    2132                                 /*get field for this base node: */
    2133                                 fieldel=field_serial[dof1];
    2134 
    2135                                 //go throfieldn all nodes which sit on top of this node, until we reach the surface,
    2136                                 //and plfield  field in field
    2137                                 for(;;){
    2138 
    2139                                         dof1=node->GetDofList1();
    2140                                         VecSetValues(field,1,&dof1,&fieldel,INSERT_VALUES);
    2141 
    2142                                         if (node->IsOnSurface())break;
    2143                                         /*get next node: */
    2144                                         node=node->GetUpperNode();
     1698
     1699                        /* Build the D matrix: we plug the gaussian weight, the thickness, the viscosity, and the jacobian determinant
     1700                         * onto this scalar matrix, so that we win some computational time: */
     1701                        D_scalar=gauss_weight*Jdet;
     1702                        for (i=0;i<6;i++){
     1703                                D[i][i]=D_scalar*viscosity;
     1704                        }
     1705                        for (i=6;i<8;i++){
     1706                                D[i][i]=-D_scalar*numpar->stokesreconditioning;
     1707                        }
     1708
     1709                        /*  Do the triple product tB*D*Bprime: */
     1710                        MatrixMultiply(&B[0][0],8,27,1,&D[0][0],8,8,0,&tBD[0][0],0);
     1711                        MatrixMultiply(&tBD[0][0],27,8,0,&B_prime_bubble[0][0],8,3,0,&Ke_gaussian[0][0],0);
     1712
     1713                        /*Add Ke_gaussian and Ke_gaussian to terms in pKe. Watch out for column orientation from matlab: */
     1714                        for(i=0;i<27;i++){
     1715                                for(j=0;j<3;j++){
     1716                                        Ke_temp[i][j]+=Ke_gaussian[i][j];
    21451717                                }
    21461718                        }
    21471719                }
    2148                 else if (
    2149                                         (strcmp(field_name,"thickness")==0) ||
    2150                                         (strcmp(field_name,"surface")==0)  ||
    2151                                         (strcmp(field_name,"bed")==0)  ||
    2152                                         (strcmp(field_name,"slopex")==0)  ||
    2153                                         (strcmp(field_name,"slopey")==0)
    2154                                   ){
    2155 
    2156                         /* node data: */
    2157                         const int    numdof=1*numgrids;
    2158                         int          doflist[numdof];
    2159                         int          nodedofs;
    2160                         double       fieldel;
    2161 
    2162                         GetDofList(&doflist[0],&numberofdofspernode);
    2163 
    2164                         /*this penta is on the bed. For each node on the base of this penta,
    2165                          * we grab the thickness. Once we know the thickness, we follow the upper nodes,
    2166                          * inserting the same thickness value into tg, until we reach the surface: */
    2167                         for(i=0;i<3;i++){
    2168 
    2169                                 node=nodes[i]; //base nodes
    2170 
    2171                                 /*get velocity for this base node: */
    2172                                 fieldel=field_serial[doflist[numberofdofspernode*i+0]];
    2173 
    2174                                 //go through all nodes which sit on top of this node, until we reach the surface,
    2175                                 //and pltg  fieldel in field:
    2176                                 for(;;){
    2177 
    2178                                         node->GetDofList(&nodedofs,&numberofdofspernode);
    2179                                         VecSetValues(field,1,&nodedofs,&fieldel,INSERT_VALUES);
    2180 
    2181                                         if (node->IsOnSurface())break;
    2182                                         /*get next node: */
    2183                                         node=node->GetUpperNode();
     1720        }
     1721
     1722        /*Deal with 2d friction at the bedrock interface: */
     1723        if ( (onbed==1) && (shelf==1)){
     1724
     1725                for(i=0;i<numgrids2d;i++){
     1726                        for(j=0;j<3;j++){
     1727                                xyz_list_tria[i][j]=xyz_list[i][j];
     1728                        }
     1729                }
     1730
     1731                xfree((void**)&first_gauss_area_coord); xfree((void**)&second_gauss_area_coord); xfree((void**)&third_gauss_area_coord); xfree((void**)&area_gauss_weights);
     1732                GaussTria (&num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &area_gauss_weights, 2);
     1733
     1734                /* Start looping on the number of gauss 2d (nodes on the bedrock) */
     1735                for (igarea=0; igarea<num_area_gauss; igarea++){
     1736                        gauss_weight=*(area_gauss_weights+igarea);
     1737                        gauss_coord[0]=*(first_gauss_area_coord+igarea);
     1738                        gauss_coord[1]=*(second_gauss_area_coord+igarea);
     1739                        gauss_coord[2]=*(third_gauss_area_coord+igarea);
     1740                        gauss_coord[3]=-1;
     1741
     1742                        gauss_coord_tria[0]=*(first_gauss_area_coord+igarea);
     1743                        gauss_coord_tria[1]=*(second_gauss_area_coord+igarea);
     1744                        gauss_coord_tria[2]=*(third_gauss_area_coord+igarea);
     1745
     1746                        /*Get the Jacobian determinant */
     1747                        tria->GetJacobianDeterminant3d(&Jdet2d, &xyz_list_tria[0][0], gauss_coord_tria);
     1748
     1749                        /* Get bed at gaussian point */
     1750                        GetParameterValue(&bed,&b[0],gauss_coord);
     1751
     1752                        /*Get L matrix : */
     1753                        tria->GetL(&L[0], &xyz_list[0][0], gauss_coord_tria,1);
     1754
     1755                        /*Get water_pressure at gaussian point */
     1756                        water_pressure=gravity*rho_water*bed;
     1757
     1758                        /*Get normal vecyor to the bed */
     1759                        SurfaceNormal(&surface_normal[0],xyz_list_tria);
     1760
     1761                        bed_normal[0]=-surface_normal[0]; //Program is for surface, so the normal to the bed is the opposite of the result
     1762                        bed_normal[1]=-surface_normal[1];
     1763                        bed_normal[2]=-surface_normal[2];
     1764
     1765                        for(i=0;i<numgrids2d;i++){
     1766                                for(j=0;j<3;j++){
     1767                                        Pe_temp[i*DOFPERGRID+j]+=water_pressure*gauss_weight*Jdet2d*L[i]*bed_normal[j];
    21841768                                }
    21851769                        }
    2186 
    2187                 }
    2188                 else throw ErrorException(__FUNCT__,exprintf("%s%s%s"," field ",field_name," not supported yet!"));
    2189 
    2190         } //if (extrude)
    2191 }
    2192 /*}}}*/
    2193 /*FUNCTION Penta GetB_vert {{{1*/
    2194 #undef __FUNCT__
    2195 #define __FUNCT__ "Penta:GetB_vert"
    2196 void Penta::GetB_vert(double* B, double* xyz_list, double* gauss_l1l2l3l4){
    2197 
    2198 
    2199         /*      Compute B  matrix. B=[dh1/dz dh2/dz dh3/dz dh4/dz dh5/dz dh6/dz];
    2200                 where hi is the interpolation function for grid i.*/
    2201 
    2202         int i;
    2203         const int NDOF3=3;
    2204         const int numgrids=6;
    2205         double dh1dh2dh3dh4dh5dh6_basic[NDOF3][numgrids];
    2206 
    2207         /*Get dh1dh2dh3dh4dh5dh6_basic in basic coordinate system: */
    2208         GetNodalFunctionsDerivativesBasic(&dh1dh2dh3dh4dh5dh6_basic[0][0],xyz_list, gauss_l1l2l3l4);
    2209 
    2210 #ifdef _ISSM_DEBUG_
    2211         for (i=0;i<numgrids;i++){
    2212                 printf("Node %i  dh/dx=%lf dh/dy=%lf dh/dz=%lf\n",i,dh1dh2dh3dh4dh5dh6_basic[0][i],dh1dh2dh3dh4dh5dh6_basic[1][i],dh1dh2dh3dh4dh5dh6_basic[2][i]);
    2213         }
    2214 #endif
    2215 
    2216         /*Build B: */
    2217         for (i=0;i<numgrids;i++){
    2218                 B[i]=dh1dh2dh3dh4dh5dh6_basic[2][i]; 
    2219         }
    2220 
    2221 }
    2222 /*}}}*/
    2223 /*FUNCTION Penta GetBPrime_vert {{{1*/
    2224 #undef __FUNCT__
    2225 #define __FUNCT__ "Penta:GetBPrime_vert"
    2226 void Penta::GetBPrime_vert(double* B, double* xyz_list, double* gauss_l1l2l3l4){
    2227 
    2228         // Compute Bprime  matrix. Bprime=[L1 L2 L3 L4 L5 L6] where Li is the nodal function for grid i
    2229 
    2230         int i;
    2231 
    2232         GetNodalFunctions(B, gauss_l1l2l3l4);
    2233 
    2234 }
    2235 /*}}}*/
    2236 /*FUNCTION Penta CreatePVectorDiagnosticVert {{{1*/
     1770                }
     1771        } //if ( (onbed==1) && (shelf==1))
     1772
     1773        /*Reduce the matrix */
     1774        ReduceVectorStokes(&Pe_reduced[0], &Ke_temp[0][0], &Pe_temp[0]);
     1775
     1776        for(i=0;i<numdof;i++){
     1777                P_terms[i]+=Pe_reduced[i];
     1778        }
     1779
     1780        /*Add P_terms to global vector pg: */
     1781        VecSetValues(pg,numdof,doflist,(const double*)P_terms,ADD_VALUES);
     1782
     1783        /*Free ressources:*/
     1784        xfree((void**)&first_gauss_area_coord);
     1785        xfree((void**)&second_gauss_area_coord);
     1786        xfree((void**)&third_gauss_area_coord);
     1787        xfree((void**)&area_gauss_weights);
     1788        xfree((void**)&vert_gauss_coord);
     1789        xfree((void**)&vert_gauss_weights);
     1790
     1791}
     1792/*}}}*/
     1793/*FUNCTION CreatePVectorDiagnosticVert {{{1*/
    22371794#undef __FUNCT__
    22381795#define __FUNCT__ "Penta:CreatePVectorDiagnosticVert"
    … …  
    23811938}
    23821939/*}}}*/
    2383 /*FUNCTION Penta ComputePressure {{{1*/
    2384 #undef __FUNCT__
    2385 #define __FUNCT__ "Penta::ComputePressure"
    2386 void  Penta::ComputePressure(Vec pg){
    2387 
    2388         int i;
    2389         const int numgrids=6;
    2390         int doflist[numgrids];
    2391         double pressure[numgrids];
    2392         double rho_ice,g;
    2393         double       xyz_list[numgrids][3];
    2394 
    2395         /*If on water, skip: */
    2396         if(onwater)return;
    2397 
    2398         /*Get node data: */
    2399         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    2400 
    2401         /*pressure is lithostatic: */
    2402         //md.pressure=md.rho_ice*md.g*(md.surface-md.z); a la matlab
    2403 
    2404         /*Get dof list on which we will plug the pressure values: */
    2405         GetDofList1(&doflist[0]);
    2406 
    2407         /*pressure is lithostatic: */
    2408         rho_ice=matpar->GetRhoIce();
    2409         g=matpar->GetG();
    2410         for(i=0;i<numgrids;i++){
    2411                 pressure[i]=rho_ice*g*(s[i]-xyz_list[i][2]);
    2412         }
    2413 
    2414         /*plug local pressure values into global pressure vector: */
    2415         VecSetValues(pg,numgrids,doflist,(const double*)pressure,INSERT_VALUES);
    2416 
    2417 }
    2418 /*}}}*/
    2419 /*FUNCTION Penta CreateKMatrixSlopeCompute {{{1*/
    2420 #undef __FUNCT__
    2421 #define __FUNCT__ "Penta::CreateKMatrixSlopeCompute"
    2422 
    2423 void  Penta::CreateKMatrixSlopeCompute(Mat Kgg,void* inputs,int analysis_type,int sub_analysis_type){
    2424 
    2425         /*Collapsed formulation: */
    2426         Tria*  tria=NULL;
    2427 
    2428         /*If on water, skip: */
    2429         if(onwater)return;
    2430 
    2431         /*Is this element on the bed? :*/
    2432         if(!onbed)return;
    2433 
    2434         /*Spawn Tria element from the base of the Penta: */
    2435         tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
    2436         tria->CreateKMatrix(Kgg,inputs, analysis_type,sub_analysis_type);
    2437         delete tria;
     1940/*FUNCTION CreatePVectorMelting {{{1*/
     1941#undef __FUNCT__
     1942#define __FUNCT__ "Penta::CreatePVectorMelting"
     1943void Penta::CreatePVectorMelting( Vec pg, void* vinputs,int analysis_type,int sub_analysis_type){
    24381944        return;
    2439 
    2440 }
    2441 /*}}}*/
    2442 /*FUNCTION Penta CreatePVectorSlopeCompute {{{1*/
    2443 #undef __FUNCT__
    2444 #define __FUNCT__ "Penta::CreatePVectorSlopeCompute"
    2445 
    2446 void Penta::CreatePVectorSlopeCompute( Vec pg, void* inputs, int analysis_type,int sub_analysis_type){
     1945}
     1946/*}}}*/
     1947/*FUNCTION CreatePVectorPrognostic {{{1*/
     1948#undef __FUNCT__
     1949#define __FUNCT__ "Penta::CreatePVectorPrognostic"
     1950
     1951void Penta::CreatePVectorPrognostic( Vec pg, void* inputs, int analysis_type,int sub_analysis_type){
    24471952
    24481953        /*Collapsed formulation: */
    … …  
    24621967}
    24631968/*}}}*/
    2464 /*FUNCTION Penta CreateKMatrixPrognostic {{{1*/
    2465 #undef __FUNCT__
    2466 #define __FUNCT__ "Penta::CreateKMatrixPrognostic"
    2467 
    2468 void  Penta::CreateKMatrixPrognostic(Mat Kgg,void* inputs,int analysis_type,int sub_analysis_type){
    2469 
    2470         /*Collapsed formulation: */
    2471         Tria*  tria=NULL;
    2472 
    2473         /*If on water, skip: */
    2474         if(onwater)return;
    2475 
    2476         /*Is this element on the bed? :*/
    2477         if(!onbed)return;
    2478 
    2479         /*Spawn Tria element from the base of the Penta: */
    2480         tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
    2481         tria->CreateKMatrix(Kgg,inputs, analysis_type,sub_analysis_type);
    2482         delete tria;
    2483         return;
    2484 
    2485 }
    2486 /*}}}*/
    2487 /*FUNCTION Penta CreatePVectorPrognostic {{{1*/
    2488 #undef __FUNCT__
    2489 #define __FUNCT__ "Penta::CreatePVectorPrognostic"
    2490 
    2491 void Penta::CreatePVectorPrognostic( Vec pg, void* inputs, int analysis_type,int sub_analysis_type){
     1969/*FUNCTION CreatePVectorSlopeCompute {{{1*/
     1970#undef __FUNCT__
     1971#define __FUNCT__ "Penta::CreatePVectorSlopeCompute"
     1972
     1973void Penta::CreatePVectorSlopeCompute( Vec pg, void* inputs, int analysis_type,int sub_analysis_type){
    24921974
    24931975        /*Collapsed formulation: */
    … …  
    25071989}
    25081990/*}}}*/
    2509 /*FUNCTION Penta ReduceMatrixStokes {{{1*/
    2510 #undef __FUNCT__
    2511 #define __FUNCT__ "ReduceMatrixStokes"
    2512 void Penta::ReduceMatrixStokes(double* Ke_reduced, double* Ke_temp){
    2513 
     1991/*FUNCTION CreatePVectorThermal {{{1*/
     1992#undef __FUNCT__
     1993#define __FUNCT__ "Penta::CreatePVectorThermal"
     1994void Penta::CreatePVectorThermal( Vec pg, void* vinputs,int analysis_type,int sub_analysis_type){
     1995
     1996
     1997        /*indexing: */
    25141998        int i,j;
    2515 
    2516         double Kii[24][24];
    2517         double Kib[24][3];
    2518         double Kbb[3][3];
    2519         double Kbi[3][24];
    2520         double Kbbinv[3][3];
    2521         double KibKbbinv[24][3];
    2522         double Kright[24][24];
    2523 
    2524         /*Create the four matrices used for reduction */
    2525         for(i=0;i<24;i++){
    2526                 for(j=0;j<24;j++){
    2527                         Kii[i][j]=*(Ke_temp+27*i+j);
    2528                 }
    2529                 for(j=0;j<3;j++){
    2530                         Kib[i][j]=*(Ke_temp+27*i+j+24);
    2531                 }
    2532         }
    2533         for(i=0;i<3;i++){
    2534                 for(j=0;j<24;j++){
    2535                         Kbi[i][j]=*(Ke_temp+27*(i+24)+j);
    2536                 }
    2537                 for(j=0;j<3;j++){
    2538                         Kbb[i][j]=*(Ke_temp+27*(i+24)+j+24);
    2539                 }
    2540         }
    2541 
    2542         /*Inverse the matrix corresponding to bubble part Kbb */
    2543         GetMatrixInvert(&Kbbinv[0][0], &Kbb[0][0]);
    2544 
    2545         /*Multiply matrices to create the reduce matrix Ke_reduced */
    2546         MatrixMultiply(&Kib[0][0],24,3,0,&Kbbinv[0][0],3,3,0,&KibKbbinv[0][0],0);
    2547         MatrixMultiply(&KibKbbinv[0][0],24,3,0,&Kbi[0][0],3,24,0,&Kright[0][0],0);
    2548 
    2549         /*Affect value to the reduced matrix */
    2550         for(i=0;i<24;i++){
    2551                 for(j=0;j<24;j++){
    2552                         *(Ke_reduced+24*i+j)=Kii[i][j]-Kright[i][j];
    2553                 }
    2554         }
    2555 }
    2556 /*}}}*/
    2557 /*FUNCTION Penta GetMatrixInvert {{{1*/
    2558 #undef __FUNCT__
    2559 #define __FUNCT__ "GetMatrixInvert"
    2560 void Penta::GetMatrixInvert(double*  Ke_invert, double* Ke){
    2561         /*Inverse a 3 by 3 matrix only */
    2562 
    2563         double a,b,c,d,e,f,g,h,i;
    2564         double det;
     1999        int found=0;
     2000
     2001        const int  numgrids=6;
     2002        const int  NDOF1=1;
     2003        const int  numdof=numgrids*NDOF1;
     2004        int        doflist[numdof];
     2005        int        numberofdofspernode;
     2006
     2007        /*Grid data: */
     2008        double        xyz_list[numgrids][3];
     2009
     2010        /* gaussian points: */
     2011        int     num_area_gauss,igarea,igvert;
     2012        double* first_gauss_area_coord  =  NULL;
     2013        double* second_gauss_area_coord =  NULL;
     2014        double* third_gauss_area_coord  =  NULL;
     2015        double* vert_gauss_coord = NULL;
     2016        double* area_gauss_weights  =  NULL;
     2017        double* vert_gauss_weights  =  NULL;
     2018        double  gauss_weight,area_gauss_weight,vert_gauss_weight;
     2019        double  gauss_coord[4];
     2020        int     area_order=2;
     2021        int       num_vert_gauss=3;
     2022
     2023        double dt;
     2024        double vx_list[numgrids];
     2025        double vy_list[numgrids];
     2026        double vz_list[numgrids];
     2027        double vxvyvz_list[numgrids][3];
     2028        double temperature_list[numgrids];
     2029        double temperature;
     2030
     2031        /*Material properties: */
     2032        double gravity,rho_ice,rho_water;
     2033        double mixed_layer_capacity,heatcapacity;
     2034        double beta,meltingpoint,thermal_exchange_velocity;
     2035
     2036        /* element parameters: */
     2037        int    friction_type;
     2038
     2039        int    dofs[3]={0,1,2};
     2040        int    dofs1[1]={0};
     2041
     2042        /*matrices: */
     2043        double P_terms[numdof]={0.0};
     2044        double L[numdof];
     2045        double l1l2l3[3];
     2046        double alpha2_list[3];
     2047        double basalfriction_list[3]={0.0};
     2048        double basalfriction;
     2049        double epsilon[6];
     2050        double epsilon_sqr[3][3];
     2051        double epsilon_matrix[3][3];
     2052
     2053        double Jdet;
     2054        double viscosity;
     2055        double epsilon_eff;
     2056        double phi;
     2057        double t_pmp;
     2058        double scalar;
     2059        double scalar_def;
     2060        double scalar_ocean;
     2061        double scalar_transient;
     2062
     2063        /*Collapsed formulation: */
     2064        Tria*  tria=NULL;
     2065        ParameterInputs* inputs=NULL;
     2066
     2067        /*If on water, skip: */
     2068        if(onwater)return;
     2069
     2070        /*recover pointers: */
     2071        inputs=(ParameterInputs*)vinputs;
     2072
     2073        /* Get node coordinates and dof list: */
     2074        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     2075        GetDofList(&doflist[0],&numberofdofspernode);
     2076
     2077        /*recovre material parameters: */
     2078        rho_water=matpar->GetRhoWater();
     2079        rho_ice=matpar->GetRhoIce();
     2080        gravity=matpar->GetG();
     2081        heatcapacity=matpar->GetHeatCapacity();
     2082        beta=matpar->GetBeta();
     2083        meltingpoint=matpar->GetMeltingPoint();
     2084
     2085        /*recover extra inputs from users, dt and velocity: */
     2086        found=inputs->Recover("velocity",&vxvyvz_list[0][0],3,dofs,numgrids,(void**)nodes);
     2087        if(!found)throw ErrorException(__FUNCT__," could not find velocity in inputs!");
     2088        found=inputs->Recover("dt",&dt);
     2089        if(!found)throw ErrorException(__FUNCT__," could not find dt in inputs!");
     2090
     2091        if(dt){
     2092                found=inputs->Recover("temperature",&temperature_list[0],1,dofs1,numgrids,(void**)nodes);
     2093                if(!found)throw ErrorException(__FUNCT__," could not find temperature in inputs!");
     2094        }
     2095
     2096        for(i=0;i<numgrids;i++){
     2097                vx_list[i]=vxvyvz_list[i][0];
     2098                vy_list[i]=vxvyvz_list[i][1];
     2099                vz_list[i]=vxvyvz_list[i][2];
     2100        }       
     2101
     2102        /* Get gaussian points and weights. Penta is an extrusion of a Tria, we therefore
     2103                get tria gaussian points as well as segment gaussian points. For tria gaussian
     2104                points, order of integration is 2, because we need to integrate the product tB*D*B'
     2105                which is a polynomial of degree 3 (see GaussTria for more details). For segment gaussian
     2106                points, same deal, which yields 3 gaussian points.: */
     2107
     2108        /*Get gaussian points: */
     2109        GaussPenta( &num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &area_gauss_weights,&vert_gauss_coord, &vert_gauss_weights, area_order, num_vert_gauss);
     2110
     2111        /* Start  looping on the number of gaussian points: */
     2112        for (igarea=0; igarea<num_area_gauss; igarea++){
     2113                for (igvert=0; igvert<num_vert_gauss; igvert++){
     2114                        /*Pick up the gaussian point: */
     2115                        area_gauss_weight=*(area_gauss_weights+igarea);
     2116                        vert_gauss_weight=*(vert_gauss_weights+igvert);
     2117                        gauss_weight=area_gauss_weight*vert_gauss_weight;
     2118                        gauss_coord[0]=*(first_gauss_area_coord+igarea);
     2119                        gauss_coord[1]=*(second_gauss_area_coord+igarea);
     2120                        gauss_coord[2]=*(third_gauss_area_coord+igarea);
     2121                        gauss_coord[3]=*(vert_gauss_coord+igvert);
     2122
     2123                        /*Compute strain rate and viscosity: */
     2124                        GetStrainRateStokes(&epsilon[0],&vxvyvz_list[0][0],&xyz_list[0][0],gauss_coord);
     2125                        matice->GetViscosity3dStokes(&viscosity,&epsilon[0]);
     2126
     2127                        /* Get Jacobian determinant: */
     2128                        GetJacobianDeterminant(&Jdet, &xyz_list[0][0],gauss_coord);
     2129
     2130                        /* Get nodal functions */
     2131                        GetNodalFunctions(&L[0], gauss_coord);
     2132
     2133                        /*Build deformational heating: */
     2134                        GetPhi(&phi, &epsilon[0], viscosity);
     2135
     2136                        /*Build pe_gaussian */
     2137                        scalar_def=phi/(rho_ice*heatcapacity)*Jdet*gauss_weight;
     2138                        if(dt){
     2139                                scalar_def=scalar_def*dt;
     2140                        }
     2141
     2142                        for(i=0;i<numgrids;i++){
     2143                                P_terms[i]+=scalar_def*L[i];
     2144                        }
     2145
     2146                        /* Build transient now */
     2147                        if(dt){
     2148                                GetParameterValue(&temperature, &temperature_list[0],gauss_coord);
     2149                                scalar_transient=temperature*Jdet*gauss_weight;
     2150                                for(i=0;i<numgrids;i++){
     2151                                        P_terms[i]+=scalar_transient*L[i];
     2152                                }
     2153                        }
     2154                }
     2155        }
     2156
     2157        /*Add pe_g to global vector pg: */
     2158        VecSetValues(pg,numdof,doflist,(const double*)P_terms,ADD_VALUES);
     2159
     2160        /* Ice/ocean heat exchange flux on ice shelf base */
     2161        if(onbed && shelf){
     2162
     2163                tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
     2164                tria->CreatePVectorThermalShelf(pg,inputs, analysis_type,sub_analysis_type);
     2165                delete tria;
     2166        }
     2167
     2168        /* Geothermal flux on ice sheet base and basal friction */
     2169        if(onbed && !shelf){
     2170
     2171                tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
     2172                tria->CreatePVectorThermalSheet(pg,inputs, analysis_type,sub_analysis_type);
     2173                delete tria;
     2174        }
     2175        extern int my_rank;
     2176
     2177cleanup_and_return:
     2178        xfree((void**)&first_gauss_area_coord);
     2179        xfree((void**)&second_gauss_area_coord);
     2180        xfree((void**)&third_gauss_area_coord);
     2181        xfree((void**)&vert_gauss_coord);
     2182        xfree((void**)&area_gauss_weights);
     2183        xfree((void**)&vert_gauss_weights);
     2184
     2185}
     2186/*}}}*/
     2187/*FUNCTION DeepEcho {{{1*/
     2188void Penta::DeepEcho(void){
     2189
     2190        printf("Penta:\n");
     2191        printf("   id: %i\n",id);
     2192        printf("   mid: %i\n",mid);
     2193        printf("   mparid: %i\n",mparid);
     2194        printf("   numparid: %i\n",numparid);
     2195
     2196        printf("   node_ids=[%i,%i,%i,%i,%i,%i]\n",node_ids[0],node_ids[1],node_ids[2],node_ids[3],node_ids[4],node_ids[5]);
     2197        printf("   node_offsets=[%i,%i,%i,%i,%i,%i]\n",node_offsets[0],node_offsets[1],node_offsets[2],node_offsets[3],node_offsets[4],node_offsets[5]);
     2198        printf("   matice_offset=%i\n",matice_offset);
     2199        printf("   matpar_offset=%i\n",matpar_offset);
     2200
     2201        printf("   h=[%i,%i,%i,%i,%i,%i]\n",h[0],h[1],h[2],h[3],h[4],h[5]);
     2202        printf("   s=[%i,%i,%i,%i,%i,%i]\n",s[0],s[1],s[2],s[3],s[4],s[5]);
     2203        printf("   b=[%i,%i,%i,%i,%i,%i]\n",b[0],b[1],b[2],b[3],b[4],b[5]);
     2204        printf("   k=[%i,%i,%i,%i,%i,%i]\n",k[0],k[1],k[2],k[3],k[4],k[5]);
     2205
     2206        printf("   friction_type: %i\n",friction_type);
     2207        printf("   p: %g\n",p);
     2208        printf("   q: %g\n",q);
     2209        printf("   shelf: %i\n",shelf);
     2210        printf("   onbed: %i\n",onbed);
     2211        printf("   onwater: %i\n",onwater);
     2212        printf("   onsurface: %i\n",onsurface);
     2213        printf("   collapse: %i\n",collapse);
     2214
     2215        printf("   melting=[%i,%i,%i,%i,%i,%i]\n",melting[0],melting[1],melting[2],melting[3],melting[4],melting[5]);
     2216        printf("   accumulation=[%i,%i,%i,%i,%i,%i]\n",accumulation[0],accumulation[1],accumulation[2],accumulation[3],accumulation[4],accumulation[5]);
     2217        printf("   geothermalflux=[%i,%i,%i,%i,%i,%i]\n",geothermalflux[0],geothermalflux[1],geothermalflux[2],geothermalflux[3],geothermalflux[4],geothermalflux[5]);
     2218        printf("   thermal_steadystate: %i\n",thermal_steadystate);
     2219        return;
     2220}
     2221/*}}}*/
     2222/*FUNCTION Du {{{1*/
     2223#undef __FUNCT__
     2224#define __FUNCT__ "Penta::Du"
     2225void  Penta::Du(Vec du_g,void* inputs,int analysis_type,int sub_analysis_type){
     2226
     2227        int i;
     2228        Tria* tria=NULL;
     2229
     2230        /*If on water, skip: */
     2231        if(onwater)return;
     2232
     2233        /*Bail out if this element if:
     2234         * -> Non collapsed and not on the surface
     2235         * -> collapsed (2d model) and not on bed) */
     2236        if ((!collapse && !onsurface) || (collapse && !onbed)){
     2237                return;
     2238        }
     2239        else if (collapse){
     2240
     2241                /*This element should be collapsed into a tria element at its base. Create this tria element,
     2242                 * and compute Du*/
     2243                tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria (lower face).
     2244                tria->Du(du_g,inputs,analysis_type,sub_analysis_type);
     2245                delete tria;
     2246                return;
     2247        }
     2248        else{
     2249
     2250                tria=(Tria*)SpawnTria(3,4,5); //grids 3, 4 and 5 make the new tria (upper face).
     2251                tria->Du(du_g,inputs,analysis_type,sub_analysis_type);
     2252                delete tria;
     2253                return;
     2254        }
     2255}
     2256/*}}}*/
     2257/*FUNCTION Echo {{{1*/
     2258void Penta::Echo(void){
     2259
     2260        printf("Penta:\n");
     2261        printf("   id: %i\n",id);
     2262        printf("   mid: %i\n",mid);
     2263        printf("   mparid: %i\n",mparid);
     2264        printf("   numparid: %i\n",numparid);
     2265
     2266        printf("   node_ids=[%i,%i,%i,%i,%i,%i]\n",node_ids[0],node_ids[1],node_ids[2],node_ids[3],node_ids[4],node_ids[5]);
     2267        printf("   node_offsets=[%i,%i,%i,%i,%i,%i]\n",node_offsets[0],node_offsets[1],node_offsets[2],node_offsets[3],node_offsets[4],node_offsets[5]);
     2268        printf("   matice_offset=%i\n",matice_offset);
     2269        printf("   matpar_offset=%i\n",matpar_offset);
     2270
     2271        printf("   h=[%g,%g,%g,%g,%g,%g]\n",h[0],h[1],h[2],h[3],h[4],h[5]);
     2272        printf("   s=[%g,%g,%g,%g,%g,%g]\n",s[0],s[1],s[2],s[3],s[4],s[5]);
     2273        printf("   b=[%g,%g,%g,%g,%g,%g]\n",b[0],b[1],b[2],b[3],b[4],b[5]);
     2274        printf("   k=[%g,%g,%g,%g,%g,%g]\n",k[0],k[1],k[2],k[3],k[4],k[5]);
     2275
     2276        printf("   friction_type: %i\n",friction_type);
     2277        printf("   p: %g\n",p);
     2278        printf("   q: %g\n",q);
     2279        printf("   shelf: %i\n",shelf);
     2280        printf("   onbed: %i\n",onbed);
     2281        printf("   onwater: %i\n",onwater);
     2282        printf("   onsurface: %i\n",onsurface);
     2283        printf("   collapse: %i\n",collapse);
     2284
     2285        printf("   melting=[%g,%g,%g,%g,%g,%g]\n",melting[0],melting[1],melting[2],melting[3],melting[4],melting[5]);
     2286        printf("   accumulation=[%g,%g,%g,%g,%g,%g]\n",accumulation[0],accumulation[1],accumulation[2],accumulation[3],accumulation[4],accumulation[5]);
     2287        printf("   geothermalflux=[%g,%g,%g,%g,%g,%g]\n",geothermalflux[0],geothermalflux[1],geothermalflux[2],geothermalflux[3],geothermalflux[4],geothermalflux[5]);
     2288        printf("   thermal_steadystate: %i\n",thermal_steadystate);
     2289        return;
     2290}
     2291/*}}}*/
     2292/*FUNCTION Enum {{{1*/
     2293int Penta::Enum(void){
     2294
     2295        return PentaEnum();
     2296
     2297}
     2298/*}}}*/
     2299/*FUNCTION FieldExtrude {{{1*/
     2300#undef __FUNCT__
     2301#define __FUNCT__ "Penta::FieldExtrude"
     2302void  Penta::FieldExtrude(Vec field,double* field_serial,char* field_name, int iscollapsed){
     2303
     2304        /* node data: */
     2305        const int    numgrids=6;
     2306        int          numberofdofspernode;
     2307        Node* node=NULL;
     2308        int   i;
     2309        int   extrude=0;
     2310
     2311        /*Figure out if we should extrude for this element: */
     2312        if (iscollapsed){
     2313                /*From higher level, we are told to extrude only elements that have the collapse flag on: */
     2314                if (collapse)extrude=1;
     2315                else extrude=0;
     2316        }
     2317        else{
     2318                /*From higher level, we are told to extrude all elements: */
     2319                extrude=1;
     2320        }
     2321
     2322        /*Now, extrusion starts from the bed on, so double check this element is on
     2323         * the bedrock: */
     2324        if(onbed==0)extrude=0;
     2325
     2326        /*Go on and extrude field: */
     2327        if (extrude){
     2328
     2329                if (strcmp(field_name,"velocity")==0){
     2330
     2331                        /* node data: */
     2332                        const int    numdof=2*numgrids;
     2333                        int          doflist[numdof];
     2334                        int          nodedofs[2];
     2335                        double       fieldel[2];
     2336
     2337
     2338                        GetDofList(&doflist[0],&numberofdofspernode);
     2339
     2340                        /*this penta is a collapsed macayeal. For each node on the base of this penta,
     2341                         * we grab the field. Once we know the field, we follow the upper nodes,
     2342                         * inserting the same field value into field, until we reach the surface: */
     2343                        for(i=0;i<3;i++){
     2344
     2345                                node=nodes[i]; //base nodes
     2346
     2347                                /*get field for this base node: */
     2348                                fieldel[0]=field_serial[doflist[numberofdofspernode*i+0]];
     2349                                fieldel[1]=field_serial[doflist[numberofdofspernode*i+1]];
     2350
     2351                                //go throfieldn all nodes which sit on top of this node, until we reach the surface,
     2352                                //and plfield  field in field
     2353                                for(;;){
     2354
     2355                                        node->GetDofList(&nodedofs[0],&numberofdofspernode);
     2356                                        VecSetValues(field,1,&nodedofs[0],&fieldel[0],INSERT_VALUES);
     2357                                        VecSetValues(field,1,&nodedofs[1],&fieldel[1],INSERT_VALUES);
     2358
     2359                                        if (node->IsOnSurface())break;
     2360                                        /*get next node: */
     2361                                        node=node->GetUpperNode();
     2362                                }
     2363                        }
     2364                } //if (strcmp(field_name,"velocity")==0)
     2365                else if (strcmp(field_name,"gradj")==0){
     2366
     2367                        /* node data: */
     2368                        int          dof1;
     2369                        double       fieldel;
     2370
     2371                        /*this penta is a collapsed macayeal. For each node on the base of this penta,
     2372                         * we grab the field. Once we know the field, we follow the upper nodes,
     2373                         * inserting the same field value into field, until we reach the surface: */
     2374                        for(i=0;i<3;i++){
     2375
     2376                                node=nodes[i]; //base nodes
     2377                                dof1=node->GetDofList1();
     2378
     2379                                /*get field for this base node: */
     2380                                fieldel=field_serial[dof1];
     2381
     2382                                //go throfieldn all nodes which sit on top of this node, until we reach the surface,
     2383                                //and plfield  field in field
     2384                                for(;;){
     2385
     2386                                        dof1=node->GetDofList1();
     2387                                        VecSetValues(field,1,&dof1,&fieldel,INSERT_VALUES);
     2388
     2389                                        if (node->IsOnSurface())break;
     2390                                        /*get next node: */
     2391                                        node=node->GetUpperNode();
     2392                                }
     2393                        }
     2394                }
     2395                else if (
     2396                                        (strcmp(field_name,"thickness")==0) ||
     2397                                        (strcmp(field_name,"surface")==0)  ||
     2398                                        (strcmp(field_name,"bed")==0)  ||
     2399                                        (strcmp(field_name,"slopex")==0)  ||
     2400                                        (strcmp(field_name,"slopey")==0)
     2401                                  ){
     2402
     2403                        /* node data: */
     2404                        const int    numdof=1*numgrids;
     2405                        int          doflist[numdof];
     2406                        int          nodedofs;
     2407                        double       fieldel;
     2408
     2409                        GetDofList(&doflist[0],&numberofdofspernode);
     2410
     2411                        /*this penta is on the bed. For each node on the base of this penta,
     2412                         * we grab the thickness. Once we know the thickness, we follow the upper nodes,
     2413                         * inserting the same thickness value into tg, until we reach the surface: */
     2414                        for(i=0;i<3;i++){
     2415
     2416                                node=nodes[i]; //base nodes
     2417
     2418                                /*get velocity for this base node: */
     2419                                fieldel=field_serial[doflist[numberofdofspernode*i+0]];
     2420
     2421                                //go through all nodes which sit on top of this node, until we reach the surface,
     2422                                //and pltg  fieldel in field:
     2423                                for(;;){
     2424
     2425                                        node->GetDofList(&nodedofs,&numberofdofspernode);
     2426                                        VecSetValues(field,1,&nodedofs,&fieldel,INSERT_VALUES);
     2427
     2428                                        if (node->IsOnSurface())break;
     2429                                        /*get next node: */
     2430                                        node=node->GetUpperNode();
     2431                                }
     2432                        }
     2433
     2434                }
     2435                else throw ErrorException(__FUNCT__,exprintf("%s%s%s"," field ",field_name," not supported yet!"));
     2436
     2437        } //if (extrude)
     2438}
     2439/*}}}*/
     2440/*FUNCTION GetB {{{1*/
     2441#undef __FUNCT__
     2442#define __FUNCT__ "Penta::GetB"
     2443void Penta::GetB(double* B, double* xyz_list, double* gauss_l1l2l3l4){
     2444
     2445        /*Compute B  matrix. B=[B1 B2 B3 B4 B5 B6] where Bi is of size 5*NDOF2.
     2446         * For grid i, Bi can be expressed in the basic coordinate system
     2447         * by:
     2448         *       Bi_basic=[ dh/dx          0      ]
     2449         *                [   0           dh/dy   ]
     2450         *                [ 1/2*dh/dy  1/2*dh/dx  ]
     2451         *                [ 1/2*dh/dz      0      ]
     2452         *                [  0         1/2*dh/dz  ]
     2453         * where h is the interpolation function for grid i.
     2454         *
     2455         * We assume B has been allocated already, of size: 5x(NDOF2*numgrids)
     2456         */
     2457
     2458        int i;
     2459        const int numgrids=6;
     2460        const int NDOF3=3;
     2461        const int NDOF2=2;
     2462
     2463        double dh1dh2dh3dh4dh5dh6_basic[NDOF3][numgrids];
     2464
     2465        /*Get dh1dh2dh3dh4dh5dh6_basic in basic coordinate system: */
     2466        GetNodalFunctionsDerivativesBasic(&dh1dh2dh3dh4dh5dh6_basic[0][0],xyz_list, gauss_l1l2l3l4);
     2467
     2468#ifdef _ISSM_DEBUG_
     2469        for (i=0;i<numgrids;i++){
     2470                printf("Node %i  dh/dx=%lf dh/dy=%lf dh/dz=%lf\n",i,dh1dh2dh3dh4dh5dh6_basic[0][i],dh1dh2dh3dh4dh5dh6_basic[1][i],dh1dh2dh3dh4dh5dh6_basic[2][i]);
     2471        }
     2472#endif
     2473
     2474        /*Build B: */
     2475        for (i=0;i<numgrids;i++){
     2476                *(B+NDOF2*numgrids*0+NDOF2*i)=dh1dh2dh3dh4dh5dh6_basic[0][i];
     2477                *(B+NDOF2*numgrids*0+NDOF2*i+1)=0.0;
     2478
     2479                *(B+NDOF2*numgrids*1+NDOF2*i)=0.0;
     2480                *(B+NDOF2*numgrids*1+NDOF2*i+1)=dh1dh2dh3dh4dh5dh6_basic[1][i];
     2481
     2482                *(B+NDOF2*numgrids*2+NDOF2*i)=(float).5*dh1dh2dh3dh4dh5dh6_basic[1][i];
     2483                *(B+NDOF2*numgrids*2+NDOF2*i+1)=(float).5*dh1dh2dh3dh4dh5dh6_basic[0][i];
     2484
     2485                *(B+NDOF2*numgrids*3+NDOF2*i)=(float).5*dh1dh2dh3dh4dh5dh6_basic[2][i];
     2486                *(B+NDOF2*numgrids*3+NDOF2*i+1)=0.0;
     2487
     2488                *(B+NDOF2*numgrids*4+NDOF2*i)=0.0;
     2489                *(B+NDOF2*numgrids*4+NDOF2*i+1)=(float).5*dh1dh2dh3dh4dh5dh6_basic[2][i];
     2490        }
     2491
     2492}
     2493/*}}}*/
     2494/*FUNCTION GetB_artdiff {{{1*/
     2495#undef __FUNCT__
     2496#define __FUNCT__ "Penta::GetB_artdiff"
     2497void Penta::GetB_artdiff(double* B_artdiff, double* xyz_list, double* gauss_coord){
     2498
     2499        /*Compute B  matrix. B=[B1 B2 B3 B4 B5 B6] where Bi is of size 5*DOFPERGRID.
     2500         * For grid i, Bi' can be expressed in the basic coordinate system
     2501         * by:
     2502         *       Bi_artdiff_basic=[ dh/dx ]
     2503         *                       [ dh/dy ]
     2504         * where h is the interpolation function for grid i.
     2505         *
     2506         * We assume B has been allocated already, of size: 2x(DOFPERGRID*numgrids)
     2507         */
     2508
     2509        int i;
     2510        const int calculationdof=3;
     2511        const int numgrids=6;
     2512        int DOFPERGRID=1;
     2513
     2514        /*Same thing in the basic coordinate system: */
     2515        double dh1dh6_basic[calculationdof][numgrids];
     2516
     2517        /*Get dh1dh2dh3 in basic coordinates system : */
     2518        GetNodalFunctionsDerivativesBasic(&dh1dh6_basic[0][0],xyz_list,gauss_coord);
     2519
     2520        /*Build B': */
     2521        for (i=0;i<numgrids;i++){
     2522                *(B_artdiff+DOFPERGRID*numgrids*0+DOFPERGRID*i)=dh1dh6_basic[0][i];
     2523                *(B_artdiff+DOFPERGRID*numgrids*1+DOFPERGRID*i)=dh1dh6_basic[1][i];
     2524        }
     2525}
     2526/*}}}*/
     2527/*FUNCTION GetB_advec {{{1*/
     2528#undef __FUNCT__
     2529#define __FUNCT__ "Penta::GetB_advec"
     2530void Penta::GetB_advec(double* B_advec, double* xyz_list, double* gauss_coord){
     2531
     2532        /*Compute B  matrix. B=[B1 B2 B3 B4 B5 B6] where Bi is of size 5*DOFPERGRID.
     2533         * For grid i, Bi' can be expressed in the basic coordinate system
     2534         * by:
     2535         *       Bi_advec_basic =[ h ]
     2536         *                       [ h ]
     2537         *                       [ h ]
     2538         * where h is the interpolation function for grid i.
     2539         *
     2540         * We assume B has been allocated already, of size: 3x(DOFPERGRID*numgrids)
     2541         */
     2542
     2543        int i;
    25652544        int calculationdof=3;
    2566 
    2567         /*Take the matrix components: */
    2568         a=*(Ke+calculationdof*0+0);
    2569         b=*(Ke+calculationdof*0+1);
    2570         c=*(Ke+calculationdof*0+2);
    2571         d=*(Ke+calculationdof*1+0);
    2572         e=*(Ke+calculationdof*1+1);
    2573         f=*(Ke+calculationdof*1+2);
    2574         g=*(Ke+calculationdof*2+0);
    2575         h=*(Ke+calculationdof*2+1);
    2576         i=*(Ke+calculationdof*2+2);
    2577 
    2578         det=a*(e*i-f*h)-b*(d*i-f*g)+c*(d*h-e*g);
    2579 
    2580         *(Ke_invert+calculationdof*0+0)=(e*i-f*h)/det;
    2581         *(Ke_invert+calculationdof*0+1)=(c*h-b*i)/det;
    2582         *(Ke_invert+calculationdof*0+2)=(b*f-c*e)/det;
    2583         *(Ke_invert+calculationdof*1+0)=(f*g-d*i)/det;
    2584         *(Ke_invert+calculationdof*1+1)=(a*i-c*g)/det;
    2585         *(Ke_invert+calculationdof*1+2)=(c*d-a*f)/det;
    2586         *(Ke_invert+calculationdof*2+0)=(d*h-e*g)/det;
    2587         *(Ke_invert+calculationdof*2+1)=(b*g-a*h)/det;
    2588         *(Ke_invert+calculationdof*2+2)=(a*e-b*d)/det;
    2589 
    2590 }
    2591 /*}}}*/
    2592 /*FUNCTION Penta SurfaceNormal {{{1*/
    2593 #undef __FUNCT__
    2594 #define __FUNCT__ "Penta::SurfaceNormal"
    2595 void Penta::SurfaceNormal(double* surface_normal, double xyz_list[3][3]){
     2545        int numgrids=6;
     2546        int DOFPERGRID=1;
     2547
     2548        /*Same thing in the basic coordinate system: */
     2549        double l1l6[6];
     2550
     2551        /*Get dh1dh2dh3 in basic coordinates system : */
     2552        GetNodalFunctions(l1l6, gauss_coord);
     2553
     2554        /*Build B': */
     2555        for (i=0;i<numgrids;i++){
     2556                *(B_advec+DOFPERGRID*numgrids*0+DOFPERGRID*i)=l1l6[i];
     2557                *(B_advec+DOFPERGRID*numgrids*1+DOFPERGRID*i)=l1l6[i];
     2558                *(B_advec+DOFPERGRID*numgrids*2+DOFPERGRID*i)=l1l6[i];
     2559        }
     2560}
     2561/*}}}*/
     2562/*FUNCTION GetB_conduct {{{1*/
     2563#undef __FUNCT__
     2564#define __FUNCT__ "Penta::GetB_conduct"
     2565void Penta::GetB_conduct(double* B_conduct, double* xyz_list, double* gauss_coord){
     2566
     2567        /*Compute B  matrix. B=[B1 B2 B3 B4 B5 B6] where Bi is of size 5*DOFPERGRID.
     2568         * For grid i, Bi' can be expressed in the basic coordinate system
     2569         * by:
     2570         *       Bi_conduct_basic=[ dh/dx ]
     2571         *                       [ dh/dy ]
     2572         *                       [ dh/dz ]
     2573         * where h is the interpolation function for grid i.
     2574         *
     2575         * We assume B has been allocated already, of size: 3x(DOFPERGRID*numgrids)
     2576         */
    25962577
    25972578        int i;
    2598         double v13[3];
    2599         double v23[3];
    2600         double normal[3];
    2601         double normal_norm;
    2602 
    2603         for (i=0;i<3;i++){
    2604                 v13[i]=xyz_list[0][i]-xyz_list[2][i];
    2605                 v23[i]=xyz_list[1][i]-xyz_list[2][i];
    2606         }
    2607 
    2608         normal[0]=v13[1]*v23[2]-v13[2]*v23[1];
    2609         normal[1]=v13[2]*v23[0]-v13[0]*v23[2];
    2610         normal[2]=v13[0]*v23[1]-v13[1]*v23[0];
    2611 
    2612         normal_norm=sqrt( pow(normal[0],2)+pow(normal[1],2)+pow(normal[2],2) );
    2613 
    2614         *(surface_normal)=normal[0]/normal_norm;
    2615         *(surface_normal+1)=normal[1]/normal_norm;
    2616         *(surface_normal+2)=normal[2]/normal_norm;
    2617 
    2618 }
    2619 /*}}}*/
    2620 /*FUNCTION Penta GetStrainRateStokes {{{1*/
    2621 #undef __FUNCT__
    2622 #define __FUNCT__ "Penta::GetStrainRateStokes"
    2623 void Penta::GetStrainRateStokes(double* epsilon, double* velocity, double* xyz_list, double* gauss_coord){
    2624 
    2625         int i,j;
    2626 
     2579        const int calculationdof=3;
    26272580        const int numgrids=6;
    2628         const int DOFVELOCITY=3;
    2629         double B[8][27];
    2630         double B_reduced[numgrids][DOFVELOCITY*numgrids];
    2631 
    2632         /*Get B matrix: */
    2633         GetBStokes(&B[0][0], xyz_list, gauss_coord);
    2634 
    2635         /*Create a reduced matrix of B to get rid of pressure */
     2581        int DOFPERGRID=1;
     2582
     2583        /*Same thing in the basic coordinate system: */
     2584        double dh1dh6_basic[calculationdof][numgrids];
     2585
     2586        /*Get dh1dh2dh3 in basic coordinates system : */
     2587        GetNodalFunctionsDerivativesBasic(&dh1dh6_basic[0][0],xyz_list,gauss_coord);
     2588
     2589        /*Build B': */
     2590        for (i=0;i<numgrids;i++){
     2591                *(B_conduct+DOFPERGRID*numgrids*0+DOFPERGRID*i)=dh1dh6_basic[0][i];
     2592                *(B_conduct+DOFPERGRID*numgrids*1+DOFPERGRID*i)=dh1dh6_basic[1][i];
     2593                *(B_conduct+DOFPERGRID*numgrids*2+DOFPERGRID*i)=dh1dh6_basic[2][i];
     2594        }
     2595}
     2596/*}}}*/
     2597/*FUNCTION GetB_vert {{{1*/
     2598#undef __FUNCT__
     2599#define __FUNCT__ "Penta:GetB_vert"
     2600void Penta::GetB_vert(double* B, double* xyz_list, double* gauss_l1l2l3l4){
     2601
     2602
     2603        /*      Compute B  matrix. B=[dh1/dz dh2/dz dh3/dz dh4/dz dh5/dz dh6/dz];
     2604                where hi is the interpolation function for grid i.*/
     2605
     2606        int i;
     2607        const int NDOF3=3;
     2608        const int numgrids=6;
     2609        double dh1dh2dh3dh4dh5dh6_basic[NDOF3][numgrids];
     2610
     2611        /*Get dh1dh2dh3dh4dh5dh6_basic in basic coordinate system: */
     2612        GetNodalFunctionsDerivativesBasic(&dh1dh2dh3dh4dh5dh6_basic[0][0],xyz_list, gauss_l1l2l3l4);
     2613
     2614#ifdef _ISSM_DEBUG_
     2615        for (i=0;i<numgrids;i++){
     2616                printf("Node %i  dh/dx=%lf dh/dy=%lf dh/dz=%lf\n",i,dh1dh2dh3dh4dh5dh6_basic[0][i],dh1dh2dh3dh4dh5dh6_basic[1][i],dh1dh2dh3dh4dh5dh6_basic[2][i]);
     2617        }
     2618#endif
     2619
     2620        /*Build B: */
     2621        for (i=0;i<numgrids;i++){
     2622                B[i]=dh1dh2dh3dh4dh5dh6_basic[2][i]; 
     2623        }
     2624
     2625}
     2626/*}}}*/
     2627/*FUNCTION GetBedList {{{1*/
     2628void Penta::GetBedList(double* bed_list){
     2629
     2630        int i;
     2631        for(i=0;i<6;i++)bed_list[i]=b[i];
     2632
     2633}
     2634/*}}}*/
     2635/*FUNCTION GetBPrime {{{1*/
     2636#undef __FUNCT__
     2637#define __FUNCT__ "Penta::GetBPrime"
     2638void Penta::GetBPrime(double* B, double* xyz_list, double* gauss_l1l2l3l4){
     2639
     2640        /*Compute B  prime matrix. B=[B1 B2 B3 B4 B5 B6] where Bi is of size 5*NDOF2.
     2641         * For grid i, Bi can be expressed in the basic coordinate system
     2642         * by:
     2643         *       Bi_basic=[ 2*dh/dx     dh/dy   ]
     2644         *                [   dh/dx    2*dh/dy  ]
     2645         *                [ dh/dy      dh/dx    ]
     2646         *                [ dh/dz         0     ]
     2647         *                [  0         dh/dz    ]
     2648         * where h is the interpolation function for grid i.
     2649         *
     2650         * We assume B has been allocated already, of size: 5x(NDOF2*numgrids)
     2651         */
     2652
     2653        int i;
     2654        const int NDOF3=3;
     2655        const int NDOF2=2;
     2656        const int numgrids=6;
     2657
     2658        double dh1dh2dh3dh4dh5dh6_basic[NDOF3][numgrids];
     2659
     2660        /*Get dh1dh2dh3dh4dh5dh6_basic in basic coordinate system: */
     2661        GetNodalFunctionsDerivativesBasic(&dh1dh2dh3dh4dh5dh6_basic[0][0],xyz_list, gauss_l1l2l3l4);
     2662
     2663#ifdef _ISSM_DEBUG_
     2664        for (i=0;i<numgrids;i++){
     2665                printf("Node %i  dh/dx=%lf dh/dy=%lf dh/dz=%lf\n",i,dh1dh2dh3dh4dh5dh6_basic[0][i],dh1dh2dh3dh4dh5dh6_basic[1][i],dh1dh2dh3dh4dh5dh6_basic[2][i]);
     2666        }
     2667#endif
     2668
     2669        /*Build BPrime: */
     2670        for (i=0;i<numgrids;i++){
     2671                *(B+NDOF2*numgrids*0+NDOF2*i)=2.0*dh1dh2dh3dh4dh5dh6_basic[0][i];
     2672                *(B+NDOF2*numgrids*0+NDOF2*i+1)=dh1dh2dh3dh4dh5dh6_basic[1][i];
     2673
     2674                *(B+NDOF2*numgrids*1+NDOF2*i)=dh1dh2dh3dh4dh5dh6_basic[0][i];
     2675                *(B+NDOF2*numgrids*1+NDOF2*i+1)=2.0*dh1dh2dh3dh4dh5dh6_basic[1][i];
     2676
     2677                *(B+NDOF2*numgrids*2+NDOF2*i)=dh1dh2dh3dh4dh5dh6_basic[1][i];
     2678                *(B+NDOF2*numgrids*2+NDOF2*i+1)=dh1dh2dh3dh4dh5dh6_basic[0][i];
     2679
     2680                *(B+NDOF2*numgrids*3+NDOF2*i)=dh1dh2dh3dh4dh5dh6_basic[2][i];
     2681                *(B+NDOF2*numgrids*3+NDOF2*i+1)=0.0;
     2682
     2683                *(B+NDOF2*numgrids*4+NDOF2*i)=0.0;
     2684                *(B+NDOF2*numgrids*4+NDOF2*i+1)=dh1dh2dh3dh4dh5dh6_basic[2][i];
     2685        }
     2686}
     2687/*}}}*/
     2688/*FUNCTION GetBprime_advec {{{1*/
     2689#undef __FUNCT__
     2690#define __FUNCT__ "Penta::GetBprime_advec"
     2691void Penta::GetBprime_advec(double* Bprime_advec, double* xyz_list, double* gauss_coord){
     2692
     2693
     2694        /*Compute B  matrix. B=[B1 B2 B3 B4 B5 B6] where Bi is of size 5*DOFPERGRID.
     2695         * For grid i, Bi' can be expressed in the basic coordinate system
     2696         * by:
     2697         *       Biprime_advec=[ dh/dx ]
     2698         *                       [ dh/dy ]
     2699         *                       [ dh/dz ]
     2700         * where h is the interpolation function for grid i.
     2701         *
     2702         * We assume B has been allocated already, of size: 3x(DOFPERGRID*numgrids)
     2703         */
     2704
     2705        int i;
     2706        const int calculationdof=3;
     2707        const int numgrids=6;
     2708        int DOFPERGRID=1;
     2709
     2710        /*Same thing in the basic coordinate system: */
     2711        double dh1dh6_basic[calculationdof][numgrids];
     2712
     2713        /*Get dh1dh2dh3 in basic coordinates system : */
     2714        GetNodalFunctionsDerivativesBasic(&dh1dh6_basic[0][0],xyz_list,gauss_coord);
     2715
     2716        /*Build B': */
     2717        for (i=0;i<numgrids;i++){
     2718                *(Bprime_advec+DOFPERGRID*numgrids*0+DOFPERGRID*i)=dh1dh6_basic[0][i];
     2719                *(Bprime_advec+DOFPERGRID*numgrids*1+DOFPERGRID*i)=dh1dh6_basic[1][i];
     2720                *(Bprime_advec+DOFPERGRID*numgrids*2+DOFPERGRID*i)=dh1dh6_basic[2][i];
     2721        }
     2722}
     2723/*}}}*/
     2724/*FUNCTION GetBPrime_vert {{{1*/
     2725#undef __FUNCT__
     2726#define __FUNCT__ "Penta:GetBPrime_vert"
     2727void Penta::GetBPrime_vert(double* B, double* xyz_list, double* gauss_l1l2l3l4){
     2728
     2729        // Compute Bprime  matrix. Bprime=[L1 L2 L3 L4 L5 L6] where Li is the nodal function for grid i
     2730
     2731        int i;
     2732
     2733        GetNodalFunctions(B, gauss_l1l2l3l4);
     2734
     2735}
     2736/*}}}*/
     2737/*FUNCTION GetBprimeStokes {{{1*/
     2738#undef __FUNCT__
     2739#define __FUNCT__ "Penta::GetBprimeStokes"
     2740void Penta::GetBprimeStokes(double* B_prime, double* xyz_list, double* gauss_coord){
     2741
     2742        /*      Compute B'  matrix. B'=[B1' B2' B3' B4' B5' B6' Bb'] where Bi' is of size 3*NDOF2.
     2743         *      For grid i, Bi' can be expressed in the basic coordinate system
     2744         *      by:
     2745         *                              Bi_basic'=[ dh/dx   0          0       0]
     2746         *                                       [   0      dh/dy      0       0]
     2747         *                                       [   0      0         dh/dz    0]
     2748         *                                       [  dh/dy   dh/dx      0       0]
     2749         *                                       [  dh/dz   0        dh/dx     0]
     2750         *                                       [   0      dh/dz    dh/dy     0]
     2751         *                                       [  dh/dx   dh/dy    dh/dz     0]
     2752         *                                       [   0      0          0       h]
     2753         *      where h is the interpolation function for grid i.
     2754         *
     2755         *      Same thing for the bubble fonction except that there is no fourth column
     2756         */
     2757
     2758        int i;
     2759        const int calculationdof=3;
     2760        const int numgrids=6;
     2761        int DOFPERGRID=4;
     2762
     2763        double dh1dh7_basic[calculationdof][numgrids+1];
     2764        double l1l6[numgrids];
     2765
     2766        /*Get dh1dh7 in basic coordinate system: */
     2767        GetNodalFunctionsDerivativesBasicStokes(&dh1dh7_basic[0][0],xyz_list, gauss_coord);
     2768
     2769        GetNodalFunctions(l1l6, gauss_coord);
     2770
     2771#ifdef _ISSM_DEBUG_
    26362772        for (i=0;i<6;i++){
    2637                 for (j=0;j<3;j++){
    2638                         B_reduced[i][j]=B[i][j];
    2639                 }
    2640                 for (j=4;j<7;j++){
    2641                         B_reduced[i][j-1]=B[i][j];
    2642                 }
    2643                 for (j=8;j<11;j++){
    2644                         B_reduced[i][j-2]=B[i][j];
    2645                 }
    2646                 for (j=12;j<15;j++){
    2647                         B_reduced[i][j-3]=B[i][j];
    2648                 }
    2649                 for (j=16;j<19;j++){
    2650                         B_reduced[i][j-4]=B[i][j];
    2651                 }
    2652                 for (j=20;j<23;j++){
    2653                         B_reduced[i][j-5]=B[i][j];
    2654                 }
    2655         }
    2656         /*Multiply B by velocity, to get strain rate: */
    2657         MatrixMultiply( &B_reduced[0][0],6,DOFVELOCITY*numgrids, 0, velocity,DOFVELOCITY*numgrids,1,0,epsilon, 0);
    2658 }
    2659 /*}}}*/
    2660 /*FUNCTION Penta GetBStokes {{{1*/
     2773                printf("Node %i  dh/dx=%lf dh/dy=%lf dh/dz=%lf \n",i,dh1dh7_basic[0][i],dh1dh7_basic[1][i]);
     2774        }
     2775
     2776#endif
     2777
     2778        /*B_primeuild B_prime: */
     2779        for (i=0;i<numgrids+1;i++){
     2780                *(B_prime+(DOFPERGRID*numgrids+3)*0+DOFPERGRID*i)=dh1dh7_basic[0][i]; //B_prime[0][DOFPERGRID*i]=dh1dh6_basic[0][i];
     2781                *(B_prime+(DOFPERGRID*numgrids+3)*0+DOFPERGRID*i+1)=0;
     2782                *(B_prime+(DOFPERGRID*numgrids+3)*0+DOFPERGRID*i+2)=0;
     2783                *(B_prime+(DOFPERGRID*numgrids+3)*1+DOFPERGRID*i)=0;
     2784                *(B_prime+(DOFPERGRID*numgrids+3)*1+DOFPERGRID*i+1)=dh1dh7_basic[1][i];
     2785                *(B_prime+(DOFPERGRID*numgrids+3)*1+DOFPERGRID*i+2)=0;
     2786                *(B_prime+(DOFPERGRID*numgrids+3)*2+DOFPERGRID*i)=0;
     2787                *(B_prime+(DOFPERGRID*numgrids+3)*2+DOFPERGRID*i+1)=0;
     2788                *(B_prime+(DOFPERGRID*numgrids+3)*2+DOFPERGRID*i+2)=dh1dh7_basic[2][i];
     2789                *(B_prime+(DOFPERGRID*numgrids+3)*3+DOFPERGRID*i)=dh1dh7_basic[1][i];
     2790                *(B_prime+(DOFPERGRID*numgrids+3)*3+DOFPERGRID*i+1)=dh1dh7_basic[0][i];
     2791                *(B_prime+(DOFPERGRID*numgrids+3)*3+DOFPERGRID*i+2)=0;
     2792                *(B_prime+(DOFPERGRID*numgrids+3)*4+DOFPERGRID*i)=dh1dh7_basic[2][i];
     2793                *(B_prime+(DOFPERGRID*numgrids+3)*4+DOFPERGRID*i+1)=0;
     2794                *(B_prime+(DOFPERGRID*numgrids+3)*4+DOFPERGRID*i+2)=dh1dh7_basic[0][i];
     2795                *(B_prime+(DOFPERGRID*numgrids+3)*5+DOFPERGRID*i)=0;
     2796                *(B_prime+(DOFPERGRID*numgrids+3)*5+DOFPERGRID*i+1)=dh1dh7_basic[2][i];
     2797                *(B_prime+(DOFPERGRID*numgrids+3)*5+DOFPERGRID*i+2)=dh1dh7_basic[1][i];
     2798                *(B_prime+(DOFPERGRID*numgrids+3)*6+DOFPERGRID*i)=dh1dh7_basic[0][i];
     2799                *(B_prime+(DOFPERGRID*numgrids+3)*6+DOFPERGRID*i+1)=dh1dh7_basic[1][i];
     2800                *(B_prime+(DOFPERGRID*numgrids+3)*6+DOFPERGRID*i+2)=dh1dh7_basic[2][i];
     2801                *(B_prime+(DOFPERGRID*numgrids+3)*7+DOFPERGRID*i)=0;
     2802                *(B_prime+(DOFPERGRID*numgrids+3)*7+DOFPERGRID*i+1)=0;
     2803                *(B_prime+(DOFPERGRID*numgrids+3)*7+DOFPERGRID*i+2)=0;
     2804        }
     2805
     2806        for (i=0;i<numgrids;i++){ //last column not for the bubble function
     2807                *(B_prime+(DOFPERGRID*numgrids+3)*0+DOFPERGRID*i+3)=0;
     2808                *(B_prime+(DOFPERGRID*numgrids+3)*1+DOFPERGRID*i+3)=0;
     2809                *(B_prime+(DOFPERGRID*numgrids+3)*2+DOFPERGRID*i+3)=0;
     2810                *(B_prime+(DOFPERGRID*numgrids+3)*3+DOFPERGRID*i+3)=0;
     2811                *(B_prime+(DOFPERGRID*numgrids+3)*4+DOFPERGRID*i+3)=0;
     2812                *(B_prime+(DOFPERGRID*numgrids+3)*5+DOFPERGRID*i+3)=0;
     2813                *(B_prime+(DOFPERGRID*numgrids+3)*6+DOFPERGRID*i+3)=0;
     2814                *(B_prime+(DOFPERGRID*numgrids+3)*7+DOFPERGRID*i+3)=l1l6[i];
     2815        }
     2816
     2817}
     2818/*}}}*/
     2819/*FUNCTION GetBStokes {{{1*/
    26612820#undef __FUNCT__
    26622821#define __FUNCT__ "Penta::GetBStokes"
    … …  
    27392898}
    27402899/*}}}*/
    2741 /*FUNCTION Penta GetBprimeStokes {{{1*/
    2742 #undef __FUNCT__
    2743 #define __FUNCT__ "Penta::GetBprimeStokes"
    2744 void Penta::GetBprimeStokes(double* B_prime, double* xyz_list, double* gauss_coord){
    2745 
    2746         /*      Compute B'  matrix. B'=[B1' B2' B3' B4' B5' B6' Bb'] where Bi' is of size 3*NDOF2.
    2747          *      For grid i, Bi' can be expressed in the basic coordinate system
    2748          *      by:
    2749          *                              Bi_basic'=[ dh/dx   0          0       0]
    2750          *                                       [   0      dh/dy      0       0]
    2751          *                                       [   0      0         dh/dz    0]
    2752          *                                       [  dh/dy   dh/dx      0       0]
    2753          *                                       [  dh/dz   0        dh/dx     0]
    2754          *                                       [   0      dh/dz    dh/dy     0]
    2755          *                                       [  dh/dx   dh/dy    dh/dz     0]
    2756          *                                       [   0      0          0       h]
    2757          *      where h is the interpolation function for grid i.
    2758          *
    2759          *      Same thing for the bubble fonction except that there is no fourth column
    2760          */
     2900/*FUNCTION GetDofList {{{1*/
     2901void  Penta::GetDofList(int* doflist,int* pnumberofdofspernode){
     2902
     2903        int i,j;
     2904        int doflist_per_node[MAXDOFSPERNODE];
     2905        int numberofdofspernode;
     2906
     2907        for(i=0;i<6;i++){
     2908                nodes[i]->GetDofList(&doflist_per_node[0],&numberofdofspernode);
     2909                for(j=0;j<numberofdofspernode;j++){
     2910                        doflist[i*numberofdofspernode+j]=doflist_per_node[j];
     2911                }
     2912        }
     2913
     2914        /*Assign output pointers:*/
     2915        *pnumberofdofspernode=numberofdofspernode;
     2916
     2917}
     2918/*}}}*/
     2919/*FUNCTION GetDofList1 {{{1*/
     2920void  Penta::GetDofList1(int* doflist){
    27612921
    27622922        int i;
    2763         const int calculationdof=3;
    2764         const int numgrids=6;
    2765         int DOFPERGRID=4;
    2766 
    2767         double dh1dh7_basic[calculationdof][numgrids+1];
    2768         double l1l6[numgrids];
    2769 
    2770         /*Get dh1dh7 in basic coordinate system: */
    2771         GetNodalFunctionsDerivativesBasicStokes(&dh1dh7_basic[0][0],xyz_list, gauss_coord);
    2772 
    2773         GetNodalFunctions(l1l6, gauss_coord);
    2774 
    2775 #ifdef _ISSM_DEBUG_
    2776         for (i=0;i<6;i++){
    2777                 printf("Node %i  dh/dx=%lf dh/dy=%lf dh/dz=%lf \n",i,dh1dh7_basic[0][i],dh1dh7_basic[1][i]);
    2778         }
    2779 
     2923        for(i=0;i<6;i++){
     2924                doflist[i]=nodes[i]->GetDofList1();
     2925        }
     2926
     2927}
     2928/*}}}*/
     2929/*FUNCTION GetId {{{1*/
     2930int    Penta::GetId(void){
     2931        return id;
     2932}
     2933/*}}}*/
     2934/*FUNCTION GetJacobian {{{1*/
     2935#undef __FUNCT__
     2936#define __FUNCT__ "Penta::GetJacobian"
     2937void Penta::GetJacobian(double* J, double* xyz_list,double* gauss_l1l2l3l4){
     2938
     2939        const int NDOF3=3;
     2940        int i,j;
     2941
     2942        /*The Jacobian is constant over the element, discard the gaussian points.
     2943         * J is assumed to have been allocated of size NDOF2xNDOF2.*/
     2944
     2945        double A1,A2,A3; //area coordinates
     2946        double xi,eta,zi; //parametric coordinates
     2947
     2948        double x1,x2,x3,x4,x5,x6;
     2949        double y1,y2,y3,y4,y5,y6;
     2950        double z1,z2,z3,z4,z5,z6;
     2951
     2952        double sqrt3=sqrt(3.0);
     2953
     2954        /*Figure out xi,eta and zi (parametric coordinates), for this gaussian point: */
     2955        A1=gauss_l1l2l3l4[0];
     2956        A2=gauss_l1l2l3l4[1];
     2957        A3=gauss_l1l2l3l4[2];
     2958
     2959        xi=A2-A1;
     2960        eta=sqrt3*A3;
     2961        zi=gauss_l1l2l3l4[3];
     2962
     2963        x1=*(xyz_list+3*0+0);
     2964        x2=*(xyz_list+3*1+0);
     2965        x3=*(xyz_list+3*2+0);
     2966        x4=*(xyz_list+3*3+0);
     2967        x5=*(xyz_list+3*4+0);
     2968        x6=*(xyz_list+3*5+0);
     2969
     2970        y1=*(xyz_list+3*0+1);
     2971        y2=*(xyz_list+3*1+1);
     2972        y3=*(xyz_list+3*2+1);
     2973        y4=*(xyz_list+3*3+1);
     2974        y5=*(xyz_list+3*4+1);
     2975        y6=*(xyz_list+3*5+1);
     2976
     2977        z1=*(xyz_list+3*0+2);
     2978        z2=*(xyz_list+3*1+2);
     2979        z3=*(xyz_list+3*2+2);
     2980        z4=*(xyz_list+3*3+2);
     2981        z5=*(xyz_list+3*4+2);
     2982        z6=*(xyz_list+3*5+2);
     2983
     2984
     2985        *(J+NDOF3*0+0)=1.0/4.0*(x1-x2-x4+x5)*zi+1.0/4.0*(-x1+x2-x4+x5);
     2986        *(J+NDOF3*1+0)=sqrt3/12.0*(x1+x2-2*x3-x4-x5+2*x6)*zi+sqrt3/12.0*(-x1-x2+2*x3-x4-x5+2*x6);
     2987        *(J+NDOF3*2+0)=sqrt3/12.0*(x1+x2-2*x3-x4-x5+2*x6)*eta+1/4*(x1-x2-x4+x5)*xi +1.0/4.0*(-x1+x5-x2+x4);
     2988
     2989        *(J+NDOF3*0+1)=1.0/4.0*(y1-y2-y4+y5)*zi+1.0/4.0*(-y1+y2-y4+y5);
     2990        *(J+NDOF3*1+1)=sqrt3/12.0*(y1+y2-2*y3-y4-y5+2*y6)*zi+sqrt3/12.0*(-y1-y2+2*y3-y4-y5+2*y6);
     2991        *(J+NDOF3*2+1)=sqrt3/12.0*(y1+y2-2*y3-y4-y5+2*y6)*eta+1.0/4.0*(y1-y2-y4+y5)*xi+1.0/4.0*(y4-y1+y5-y2);
     2992
     2993        *(J+NDOF3*0+2)=1.0/4.0*(z1-z2-z4+z5)*zi+1.0/4.0*(-z1+z2-z4+z5);
     2994        *(J+NDOF3*1+2)=sqrt3/12.0*(z1+z2-2*z3-z4-z5+2*z6)*zi+sqrt3/12.0*(-z1-z2+2*z3-z4-z5+2*z6);
     2995        *(J+NDOF3*2+2)=sqrt3/12.0*(z1+z2-2*z3-z4-z5+2*z6)*eta+1.0/4.0*(z1-z2-z4+z5)*xi+1.0/4.0*(-z1+z5-z2+z4);
     2996
     2997#ifdef _ISSM_DEBUG_
     2998        for(i=0;i<3;i++){
     2999                for (j=0;j<3;j++){
     3000                        printf("%lf ",*(J+NDOF3*i+j));
     3001                }
     3002                printf("\n");
     3003        }
    27803004#endif
    2781 
    2782         /*B_primeuild B_prime: */
    2783         for (i=0;i<numgrids+1;i++){
    2784                 *(B_prime+(DOFPERGRID*numgrids+3)*0+DOFPERGRID*i)=dh1dh7_basic[0][i]; //B_prime[0][DOFPERGRID*i]=dh1dh6_basic[0][i];
    2785                 *(B_prime+(DOFPERGRID*numgrids+3)*0+DOFPERGRID*i+1)=0;
    2786                 *(B_prime+(DOFPERGRID*numgrids+3)*0+DOFPERGRID*i+2)=0;
    2787                 *(B_prime+(DOFPERGRID*numgrids+3)*1+DOFPERGRID*i)=0;
    2788                 *(B_prime+(DOFPERGRID*numgrids+3)*1+DOFPERGRID*i+1)=dh1dh7_basic[1][i];
    2789                 *(B_prime+(DOFPERGRID*numgrids+3)*1+DOFPERGRID*i+2)=0;
    2790                 *(B_prime+(DOFPERGRID*numgrids+3)*2+DOFPERGRID*i)=0;
    2791                 *(B_prime+(DOFPERGRID*numgrids+3)*2+DOFPERGRID*i+1)=0;
    2792                 *(B_prime+(DOFPERGRID*numgrids+3)*2+DOFPERGRID*i+2)=dh1dh7_basic[2][i];
    2793                 *(B_prime+(DOFPERGRID*numgrids+3)*3+DOFPERGRID*i)=dh1dh7_basic[1][i];
    2794                 *(B_prime+(DOFPERGRID*numgrids+3)*3+DOFPERGRID*i+1)=dh1dh7_basic[0][i];
    2795                 *(B_prime+(DOFPERGRID*numgrids+3)*3+DOFPERGRID*i+2)=0;
    2796                 *(B_prime+(DOFPERGRID*numgrids+3)*4+DOFPERGRID*i)=dh1dh7_basic[2][i];
    2797                 *(B_prime+(DOFPERGRID*numgrids+3)*4+DOFPERGRID*i+1)=0;
    2798                 *(B_prime+(DOFPERGRID*numgrids+3)*4+DOFPERGRID*i+2)=dh1dh7_basic[0][i];
    2799                 *(B_prime+(DOFPERGRID*numgrids+3)*5+DOFPERGRID*i)=0;
    2800                 *(B_prime+(DOFPERGRID*numgrids+3)*5+DOFPERGRID*i+1)=dh1dh7_basic[2][i];
    2801                 *(B_prime+(DOFPERGRID*numgrids+3)*5+DOFPERGRID*i+2)=dh1dh7_basic[1][i];
    2802                 *(B_prime+(DOFPERGRID*numgrids+3)*6+DOFPERGRID*i)=dh1dh7_basic[0][i];
    2803                 *(B_prime+(DOFPERGRID*numgrids+3)*6+DOFPERGRID*i+1)=dh1dh7_basic[1][i];
    2804                 *(B_prime+(DOFPERGRID*numgrids+3)*6+DOFPERGRID*i+2)=dh1dh7_basic[2][i];
    2805                 *(B_prime+(DOFPERGRID*numgrids+3)*7+DOFPERGRID*i)=0;
    2806                 *(B_prime+(DOFPERGRID*numgrids+3)*7+DOFPERGRID*i+1)=0;
    2807                 *(B_prime+(DOFPERGRID*numgrids+3)*7+DOFPERGRID*i+2)=0;
    2808         }
    2809 
    2810         for (i=0;i<numgrids;i++){ //last column not for the bubble function
    2811                 *(B_prime+(DOFPERGRID*numgrids+3)*0+DOFPERGRID*i+3)=0;
    2812                 *(B_prime+(DOFPERGRID*numgrids+3)*1+DOFPERGRID*i+3)=0;
    2813                 *(B_prime+(DOFPERGRID*numgrids+3)*2+DOFPERGRID*i+3)=0;
    2814                 *(B_prime+(DOFPERGRID*numgrids+3)*3+DOFPERGRID*i+3)=0;
    2815                 *(B_prime+(DOFPERGRID*numgrids+3)*4+DOFPERGRID*i+3)=0;
    2816                 *(B_prime+(DOFPERGRID*numgrids+3)*5+DOFPERGRID*i+3)=0;
    2817                 *(B_prime+(DOFPERGRID*numgrids+3)*6+DOFPERGRID*i+3)=0;
    2818                 *(B_prime+(DOFPERGRID*numgrids+3)*7+DOFPERGRID*i+3)=l1l6[i];
    2819         }
    2820 
    2821 }
    2822 /*}}}*/
    2823 /*FUNCTION Penta GetLStokes {{{1*/
     3005}
     3006/*}}}*/
     3007/*FUNCTION GetJacobianDeterminant {{{1*/
     3008#undef __FUNCT__
     3009#define __FUNCT__ "Penta::GetJacobianDeterminant"
     3010void Penta::GetJacobianDeterminant(double*  Jdet, double* xyz_list,double* gauss_l1l2l3l4){
     3011
     3012        /*On a penta, Jacobian varies according to coordinates. We need to get the Jacobian, and take
     3013         * the determinant of it: */
     3014        const int NDOF3=3;
     3015
     3016        double J[NDOF3][NDOF3];
     3017
     3018        GetJacobian(&J[0][0],xyz_list,gauss_l1l2l3l4);
     3019
     3020        *Jdet= J[0][0]*J[1][1]*J[2][2]-J[0][0]*J[1][2]*J[2][1]-J[1][0]*J[0][1]*J[2][2]+J[1][0]*J[0][2]*J[2][1]+J[2][0]*J[0][1]*J[1][2]-J[2][0]*J[0][2]*J[1][1];
     3021        if(*Jdet<0){
     3022                printf("%s%s%i\n",__FUNCT__," error message: negative jacobian determinant on element ",id);
     3023        }
     3024}
     3025/*}}}*/
     3026/*FUNCTION GetLStokes {{{1*/
    28243027#undef __FUNCT__
    28253028#define __FUNCT__ "Penta::GetLStokes"
    … …  
    29283131}
    29293132/*}}}*/
    2930 /*FUNCTION Penta GetLprimeStokes {{{1*/
     3133/*FUNCTION GetLprimeStokes {{{1*/
    29313134#undef __FUNCT__
    29323135#define __FUNCT__ "Penta::GetLprimeStokes"
    … …  
    30373240}
    30383241/*}}}*/
    3039 /*FUNCTION Penta GetNodalFunctionsDerivativesBasicStokes {{{1*/
     3242/*FUNCTION GetMatrixInvert {{{1*/
     3243#undef __FUNCT__
     3244#define __FUNCT__ "GetMatrixInvert"
     3245void Penta::GetMatrixInvert(double*  Ke_invert, double* Ke){
     3246        /*Inverse a 3 by 3 matrix only */
     3247
     3248        double a,b,c,d,e,f,g,h,i;
     3249        double det;
     3250        int calculationdof=3;
     3251
     3252        /*Take the matrix components: */
     3253        a=*(Ke+calculationdof*0+0);
     3254        b=*(Ke+calculationdof*0+1);
     3255        c=*(Ke+calculationdof*0+2);
     3256        d=*(Ke+calculationdof*1+0);
     3257        e=*(Ke+calculationdof*1+1);
     3258        f=*(Ke+calculationdof*1+2);
     3259        g=*(Ke+calculationdof*2+0);
     3260        h=*(Ke+calculationdof*2+1);
     3261        i=*(Ke+calculationdof*2+2);
     3262
     3263        det=a*(e*i-f*h)-b*(d*i-f*g)+c*(d*h-e*g);
     3264
     3265        *(Ke_invert+calculationdof*0+0)=(e*i-f*h)/det;
     3266        *(Ke_invert+calculationdof*0+1)=(c*h-b*i)/det;
     3267        *(Ke_invert+calculationdof*0+2)=(b*f-c*e)/det;
     3268        *(Ke_invert+calculationdof*1+0)=(f*g-d*i)/det;
     3269        *(Ke_invert+calculationdof*1+1)=(a*i-c*g)/det;
     3270        *(Ke_invert+calculationdof*1+2)=(c*d-a*f)/det;
     3271        *(Ke_invert+calculationdof*2+0)=(d*h-e*g)/det;
     3272        *(Ke_invert+calculationdof*2+1)=(b*g-a*h)/det;
     3273        *(Ke_invert+calculationdof*2+2)=(a*e-b*d)/det;
     3274
     3275}
     3276/*}}}*/
     3277/*FUNCTION GetName {{{1*/
     3278char* Penta::GetName(void){
     3279        return "penta";
     3280}
     3281/*}}}*/
     3282/*FUNCTION GetNodalFunctionsDerivativesBasic {{{1*/
     3283#undef __FUNCT__
     3284#define __FUNCT__ "Penta::GetNodalFunctionsDerivativesBasic"
     3285void Penta::GetNodalFunctionsDerivativesBasic(double* dh1dh2dh3dh4dh5dh6_basic,double* xyz_list, double* gauss_l1l2l3l4){
     3286
     3287        /*This routine returns the values of the nodal functions derivatives  (with respect to the basic coordinate system: */
     3288
     3289
     3290        int i;
     3291        const int NDOF3=3;
     3292        const int numgrids=6;
     3293
     3294        double dh1dh2dh3dh4dh5dh6_param[NDOF3][numgrids];
     3295        double Jinv[NDOF3][NDOF3];
     3296
     3297        /*Get derivative values with respect to parametric coordinate system: */
     3298        GetNodalFunctionsDerivativesParams(&dh1dh2dh3dh4dh5dh6_param[0][0], gauss_l1l2l3l4);
     3299
     3300        /*Get Jacobian invert: */
     3301        GetJacobianInvert(&Jinv[0][0], xyz_list, gauss_l1l2l3l4);
     3302
     3303        /*Build dh1dh2dh3_basic:
     3304         *
     3305         * [dhi/dx]= Jinv*[dhi/dr]
     3306         * [dhi/dy]       [dhi/ds]
     3307         * [dhi/dz]       [dhi/dn]
     3308         */
     3309
     3310        for (i=0;i<numgrids;i++){
     3311                *(dh1dh2dh3dh4dh5dh6_basic+numgrids*0+i)=Jinv[0][0]*dh1dh2dh3dh4dh5dh6_param[0][i]+Jinv[0][1]*dh1dh2dh3dh4dh5dh6_param[1][i]+Jinv[0][2]*dh1dh2dh3dh4dh5dh6_param[2][i];
     3312                *(dh1dh2dh3dh4dh5dh6_basic+numgrids*1+i)=Jinv[1][0]*dh1dh2dh3dh4dh5dh6_param[0][i]+Jinv[1][1]*dh1dh2dh3dh4dh5dh6_param[1][i]+Jinv[1][2]*dh1dh2dh3dh4dh5dh6_param[2][i];
     3313                *(dh1dh2dh3dh4dh5dh6_basic+numgrids*2+i)=Jinv[2][0]*dh1dh2dh3dh4dh5dh6_param[0][i]+Jinv[2][1]*dh1dh2dh3dh4dh5dh6_param[1][i]+Jinv[2][2]*dh1dh2dh3dh4dh5dh6_param[2][i];
     3314        }
     3315
     3316}
     3317/*}}}*/
     3318/*FUNCTION GetNodalFunctionsDerivativesBasicStokes {{{1*/
    30403319#undef __FUNCT__
    30413320#define __FUNCT__ "Penta::GetNodalFunctionsDerivativesBasicStokes"
    … …  
    30733352}
    30743353/*}}}*/
    3075 /*FUNCTION Penta GetNodalFunctionsDerivativesParamsStokes {{{1*/
     3354/*FUNCTION GetNodalFunctionsDerivativesParams {{{1*/
     3355#undef __FUNCT__
     3356#define __FUNCT__ "Penta::GetNodalFunctionsDerivativesParams"
     3357void Penta::GetNodalFunctionsDerivativesParams(double* dl1dl2dl3dl4dl5dl6,double* gauss_l1l2l3l4){
     3358
     3359        /*This routine returns the values of the nodal functions derivatives  (with respect to the
     3360         * natural coordinate system) at the gaussian point. Those values vary along xi,eta,z */
     3361
     3362        const int numgrids=6;
     3363        double A1,A2,A3,z;
     3364        double sqrt3=sqrt(3.0);
     3365
     3366        A1=gauss_l1l2l3l4[0]; //first area coordinate value. In term of xi and eta: A1=(1-xi)/2-eta/(2*sqrt(3));
     3367        A2=gauss_l1l2l3l4[1]; //second area coordinate value In term of xi and eta: A2=(1+xi)/2-eta/(2*sqrt(3));
     3368        A3=gauss_l1l2l3l4[2]; //third area coordinate value  In term of xi and eta: A3=y/sqrt(3);
     3369        z=gauss_l1l2l3l4[3]; //fourth vertical coordinate value. Corresponding nodal function: (1-z)/2 and (1+z)/2
     3370
     3371
     3372        /*First nodal function derivatives. The corresponding nodal function is N=A1*(1-z)/2. Its derivatives follow*/
     3373        *(dl1dl2dl3dl4dl5dl6+numgrids*0+0)=-1.0/2.0*(1.0-z)/2.0;
     3374        *(dl1dl2dl3dl4dl5dl6+numgrids*1+0)=-1.0/2.0/sqrt3*(1.0-z)/2.0;
     3375        *(dl1dl2dl3dl4dl5dl6+numgrids*2+0)=-1.0/2.0*A1;
     3376
     3377        /*Second nodal function: The corresponding nodal function is N=A2*(1-z)/2. Its derivatives follow*/
     3378        *(dl1dl2dl3dl4dl5dl6+numgrids*0+1)=1.0/2.0*(1.0-z)/2.0;
     3379        *(dl1dl2dl3dl4dl5dl6+numgrids*1+1)=-1.0/2.0/sqrt3*(1.0-z)/2.0;
     3380        *(dl1dl2dl3dl4dl5dl6+numgrids*2+1)=-1.0/2.0*A2;
     3381
     3382        /*Third nodal function: The corresponding nodal function is N=A3*(1-z)/2. Its derivatives follow*/
     3383        *(dl1dl2dl3dl4dl5dl6+numgrids*0+2)=0.0;
     3384        *(dl1dl2dl3dl4dl5dl6+numgrids*1+2)=1.0/sqrt3*(1.0-z)/2.0;
     3385        *(dl1dl2dl3dl4dl5dl6+numgrids*2+2)=-1.0/2.0*A3;
     3386
     3387        /*Fourth nodal function: The corresponding nodal function is N=A1*(1+z)/2. Its derivatives follow*/
     3388        *(dl1dl2dl3dl4dl5dl6+numgrids*0+3)=-1.0/2.0*(1.0+z)/2.0;
     3389        *(dl1dl2dl3dl4dl5dl6+numgrids*1+3)=-1.0/2.0/sqrt3*(1.0+z)/2.0;
     3390        *(dl1dl2dl3dl4dl5dl6+numgrids*2+3)=1.0/2.0*A1;
     3391
     3392        /*Fifth nodal function: The corresponding nodal function is N=A2*(1+z)/2. Its derivatives follow*/
     3393        *(dl1dl2dl3dl4dl5dl6+numgrids*0+4)=1.0/2.0*(1.0+z)/2.0;
     3394        *(dl1dl2dl3dl4dl5dl6+numgrids*1+4)=-1.0/2.0/sqrt3*(1.0+z)/2.0;
     3395        *(dl1dl2dl3dl4dl5dl6+numgrids*2+4)=1.0/2.0*A2;
     3396
     3397        /*Sixth nodal function: The corresponding nodal function is N=A3*(1+z)/2. Its derivatives follow*/
     3398        *(dl1dl2dl3dl4dl5dl6+numgrids*0+5)=0.0;
     3399        *(dl1dl2dl3dl4dl5dl6+numgrids*1+5)=1.0/sqrt3*(1.0+z)/2.0;
     3400        *(dl1dl2dl3dl4dl5dl6+numgrids*2+5)=1.0/2.0*A3;
     3401}
     3402/*}}}*/
     3403/*FUNCTION GetNodalFunctionsDerivativesParamsStokes {{{1*/
    30763404#undef __FUNCT__
    30773405#define __FUNCT__ "Penta::GetNodalFunctionsDerivativesParamsStokes"
    … …  
    31253453}
    31263454/*}}}*/
    3127 /*FUNCTION Penta CreatePVectorDiagnosticStokes {{{1*/
    3128 #undef __FUNCT__
    3129 #define __FUNCT__ "Penta::CreatePVectorDiagnosticStokes"
    3130 void Penta::CreatePVectorDiagnosticStokes( Vec pg, void* vinputs,int analysis_type,int sub_analysis_type){
    3131 
    3132         /*indexing: */
    3133         int i,j;
    3134 
    3135         const int numgrids=6;
    3136         const int DOFPERGRID=4;
    3137         const int numdof=numgrids*DOFPERGRID;
    3138         const int numgrids2d=3;
    3139         int numdof2d=numgrids2d*DOFPERGRID;
    3140         int doflist[numdof];
    3141         int numberofdofspernode;
    3142 
    3143         /*Material properties: */
    3144         double         gravity,rho_ice,rho_water;
    3145 
    3146         /*parameters: */
    3147         double             xyz_list_tria[numgrids2d][3];
    3148         double         xyz_list[numgrids][3];
    3149         double             surface_normal[3];
    3150         double             bed_normal[3];
    3151         double         bed;
    3152         double         vxvyvz_list[numgrids][3];
    3153 
    3154         /* gaussian points: */
    3155         int     num_area_gauss;
    3156         int     igarea,igvert;
    3157         double* first_gauss_area_coord  =  NULL;
    3158         double* second_gauss_area_coord =  NULL;
    3159         double* third_gauss_area_coord  =  NULL;
    3160         double* vert_gauss_coord = NULL;
    3161         double* area_gauss_weights  =  NULL;
    3162         double* vert_gauss_weights  =  NULL;
    3163 
    3164         /* specific gaussian point: */
    3165         double  gauss_weight,area_gauss_weight,vert_gauss_weight;
    3166         double  gauss_coord[4];
    3167         double  gauss_coord_tria[3];
    3168 
    3169         int     area_order=5;
    3170         int       num_vert_gauss=5;
    3171 
    3172         double  epsilon[6]; /* epsilon=[exx,eyy,ezz,exy,exz,eyz];*/
    3173         double  viscosity;
    3174         double  water_pressure;
    3175         int     dofs[3]={0,1,2};
    3176 
    3177         /*matrices: */
    3178         double     Pe_temp[27]={0.0}; //for the six nodes and the bubble
    3179         double     Pe_gaussian[27]={0.0}; //for the six nodes and the bubble
    3180         double     Ke_temp[27][3]={0.0}; //for the six nodes and the bubble
    3181         double     Pe_reduced[numdof]; //for the six nodes only
    3182         double     Ke_gaussian[27][3];
    3183         double     L[3]; //for the three nodes of the bed
    3184         double     l1l7[7]; //for the six nodes and the bubble
    3185         double     B[8][27];
    3186         double     B_prime[8][27];
    3187         double     B_prime_bubble[8][3];
    3188         double     Jdet;
    3189         double     Jdet2d;
    3190         double     D[8][8]={0.0};
    3191         double     D_scalar;
    3192         double     tBD[27][8];
    3193         double     P_terms[numdof];
    3194 
    3195         ParameterInputs* inputs=NULL;
    3196         Tria*            tria=NULL;
    3197 
    3198         /*If on water, skip load: */
    3199         if(onwater)return;
    3200 
    3201         /*recover pointers: */
    3202         inputs=(ParameterInputs*)vinputs;
    3203 
    3204         /* Set P_terms to 0: */
    3205         for(i=0;i<numdof;i++){
    3206                 P_terms[i]=0;
    3207         }       
    3208 
    3209         /*recovre material parameters: */
    3210         rho_water=matpar->GetRhoWater();
    3211         rho_ice=matpar->GetRhoIce();
    3212         gravity=matpar->GetG();
    3213 
    3214         /*recover extra inputs from users, at current convergence iteration: */
    3215         inputs->Recover("velocity",&vxvyvz_list[0][0],3,dofs,numgrids,(void**)nodes);
    3216 
    3217         /* Get node coordinates and dof list: */
    3218         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    3219         GetDofList(&doflist[0],&numberofdofspernode);
    3220 
    3221         /* Get gaussian points and weights. Penta is an extrusion of a Tria, we therefore
    3222                 get tria gaussian points as well as segment gaussian points. For tria gaussian
    3223                 points, order of integration is 2, because we need to integrate the product tB*D*B'
    3224                 which is a polynomial of degree 3 (see GaussTria for more details). For segment gaussian
    3225                 points, same deal, which yields 3 gaussian points.*/
    3226 
    3227         /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
    3228         GaussPenta( &num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &area_gauss_weights,&vert_gauss_coord, &vert_gauss_weights, area_order, num_vert_gauss);
    3229 
    3230         /* Start  looping on the number of gaussian points: */
    3231         for (igarea=0; igarea<num_area_gauss; igarea++){
    3232                 for (igvert=0; igvert<num_vert_gauss; igvert++){
    3233                         /*Pick up the gaussian point: */
    3234                         area_gauss_weight=*(area_gauss_weights+igarea);
    3235                         vert_gauss_weight=*(vert_gauss_weights+igvert);
    3236                         gauss_weight=area_gauss_weight*vert_gauss_weight;
    3237                         gauss_coord[0]=*(first_gauss_area_coord+igarea);
    3238                         gauss_coord[1]=*(second_gauss_area_coord+igarea);
    3239                         gauss_coord[2]=*(third_gauss_area_coord+igarea);
    3240                         gauss_coord[3]=*(vert_gauss_coord+igvert);
    3241 
    3242                         /*Compute strain rate and viscosity: */
    3243                         GetStrainRateStokes(&epsilon[0],&vxvyvz_list[0][0],&xyz_list[0][0],gauss_coord);
    3244                         matice->GetViscosity3dStokes(&viscosity,&epsilon[0]);
    3245 
    3246                         /* Get Jacobian determinant: */
    3247                         GetJacobianDeterminant(&Jdet, &xyz_list[0][0],gauss_coord);
    3248 
    3249                         /* Get nodal functions */
    3250                         GetNodalFunctionsStokes(&l1l7[0], gauss_coord);
    3251 
    3252                         /* Build gaussian vector */
    3253                         for(i=0;i<numgrids+1;i++){
    3254                                 Pe_gaussian[i*DOFPERGRID+2]=-rho_ice*gravity*Jdet*gauss_weight*l1l7[i];
    3255                         }
    3256 
    3257                         /*Add Pe_gaussian to terms in Pe_temp. Watch out for column orientation from matlab: */
    3258                         for(i=0;i<27;i++){
    3259                                 Pe_temp[i]+=Pe_gaussian[i];
    3260                         }
    3261 
    3262                         /*Get B and Bprime matrices: */
    3263                         GetBStokes(&B[0][0],&xyz_list[0][0],gauss_coord);
    3264                         GetBprimeStokes(&B_prime[0][0],&xyz_list[0][0], gauss_coord);
    3265 
    3266                         /*Get bubble part of Bprime */
    3267                         for(i=0;i<8;i++){
    3268                                 for(j=0;j<3;j++){
    3269                                         B_prime_bubble[i][j]=B_prime[i][j+24];
    3270                                 }
    3271                         }
    3272 
    3273                         /* Build the D matrix: we plug the gaussian weight, the thickness, the viscosity, and the jacobian determinant
    3274                          * onto this scalar matrix, so that we win some computational time: */
    3275                         D_scalar=gauss_weight*Jdet;
    3276                         for (i=0;i<6;i++){
    3277                                 D[i][i]=D_scalar*viscosity;
    3278                         }
    3279                         for (i=6;i<8;i++){
    3280                                 D[i][i]=-D_scalar*numpar->stokesreconditioning;
    3281                         }
    3282 
    3283                         /*  Do the triple product tB*D*Bprime: */
    3284                         MatrixMultiply(&B[0][0],8,27,1,&D[0][0],8,8,0,&tBD[0][0],0);
    3285                         MatrixMultiply(&tBD[0][0],27,8,0,&B_prime_bubble[0][0],8,3,0,&Ke_gaussian[0][0],0);
    3286 
    3287                         /*Add Ke_gaussian and Ke_gaussian to terms in pKe. Watch out for column orientation from matlab: */
    3288                         for(i=0;i<27;i++){
    3289                                 for(j=0;j<3;j++){
    3290                                         Ke_temp[i][j]+=Ke_gaussian[i][j];
    3291                                 }
    3292                         }
    3293                 }
    3294         }
    3295 
    3296         /*Deal with 2d friction at the bedrock interface: */
    3297         if ( (onbed==1) && (shelf==1)){
    3298 
    3299                 for(i=0;i<numgrids2d;i++){
    3300                         for(j=0;j<3;j++){
    3301                                 xyz_list_tria[i][j]=xyz_list[i][j];
    3302                         }
    3303                 }
    3304 
    3305                 xfree((void**)&first_gauss_area_coord); xfree((void**)&second_gauss_area_coord); xfree((void**)&third_gauss_area_coord); xfree((void**)&area_gauss_weights);
    3306                 GaussTria (&num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &area_gauss_weights, 2);
    3307 
    3308                 /* Start looping on the number of gauss 2d (nodes on the bedrock) */
    3309                 for (igarea=0; igarea<num_area_gauss; igarea++){
    3310                         gauss_weight=*(area_gauss_weights+igarea);
    3311                         gauss_coord[0]=*(first_gauss_area_coord+igarea);
    3312                         gauss_coord[1]=*(second_gauss_area_coord+igarea);
    3313                         gauss_coord[2]=*(third_gauss_area_coord+igarea);
    3314                         gauss_coord[3]=-1;
    3315 
    3316                         gauss_coord_tria[0]=*(first_gauss_area_coord+igarea);
    3317                         gauss_coord_tria[1]=*(second_gauss_area_coord+igarea);
    3318                         gauss_coord_tria[2]=*(third_gauss_area_coord+igarea);
    3319 
    3320                         /*Get the Jacobian determinant */
    3321                         tria->GetJacobianDeterminant3d(&Jdet2d, &xyz_list_tria[0][0], gauss_coord_tria);
    3322 
    3323                         /* Get bed at gaussian point */
    3324                         GetParameterValue(&bed,&b[0],gauss_coord);
    3325 
    3326                         /*Get L matrix : */
    3327                         tria->GetL(&L[0], &xyz_list[0][0], gauss_coord_tria,1);
    3328 
    3329                         /*Get water_pressure at gaussian point */
    3330                         water_pressure=gravity*rho_water*bed;
    3331 
    3332                         /*Get normal vecyor to the bed */
    3333                         SurfaceNormal(&surface_normal[0],xyz_list_tria);
    3334 
    3335                         bed_normal[0]=-surface_normal[0]; //Program is for surface, so the normal to the bed is the opposite of the result
    3336                         bed_normal[1]=-surface_normal[1];
    3337                         bed_normal[2]=-surface_normal[2];
    3338 
    3339                         for(i=0;i<numgrids2d;i++){
    3340                                 for(j=0;j<3;j++){
    3341                                         Pe_temp[i*DOFPERGRID+j]+=water_pressure*gauss_weight*Jdet2d*L[i]*bed_normal[j];
    3342                                 }
    3343                         }
    3344                 }
    3345         } //if ( (onbed==1) && (shelf==1))
    3346 
    3347         /*Reduce the matrix */
    3348         ReduceVectorStokes(&Pe_reduced[0], &Ke_temp[0][0], &Pe_temp[0]);
    3349 
    3350         for(i=0;i<numdof;i++){
    3351                 P_terms[i]+=Pe_reduced[i];
    3352         }
    3353 
    3354         /*Add P_terms to global vector pg: */
    3355         VecSetValues(pg,numdof,doflist,(const double*)P_terms,ADD_VALUES);
    3356 
    3357         /*Free ressources:*/
    3358         xfree((void**)&first_gauss_area_coord);
    3359         xfree((void**)&second_gauss_area_coord);
    3360         xfree((void**)&third_gauss_area_coord);
    3361         xfree((void**)&area_gauss_weights);
    3362         xfree((void**)&vert_gauss_coord);
    3363         xfree((void**)&vert_gauss_weights);
    3364 
    3365 }
    3366 /*}}}*/
    3367 /*FUNCTION Penta ReduceVectorStokes {{{1*/
    3368 #undef __FUNCT__
    3369 #define __FUNCT__ "Penta::ReduceVectorStokes"
    3370 void Penta::ReduceVectorStokes(double* Pe_reduced, double* Ke_temp, double* Pe_temp){
    3371 
    3372         int i,j;
    3373 
    3374         double Pi[24];
    3375         double Pb[3];
    3376         double Kbb[3][3];
    3377         double Kib[24][3];
    3378         double Kbbinv[3][3];
    3379         double KibKbbinv[24][3];
    3380         double Pright[24];
    3381 
    3382         /*Create the four matrices used for reduction */
    3383         for(i=0;i<24;i++){
    3384                 Pi[i]=*(Pe_temp+i);
    3385         }
    3386         for(i=0;i<3;i++){
    3387                 Pb[i]=*(Pe_temp+i+24);
    3388         }
    3389         for(j=0;j<3;j++){
    3390                 for(i=0;i<24;i++){
    3391                         Kib[i][j]=*(Ke_temp+3*i+j);
    3392                 }
    3393                 for(i=0;i<3;i++){
    3394                         Kbb[i][j]=*(Ke_temp+3*(i+24)+j);
    3395                 }
    3396         }
    3397 
    3398         /*Inverse the matrix corresponding to bubble part Kbb */
    3399         GetMatrixInvert(&Kbbinv[0][0], &Kbb[0][0]);
    3400 
    3401         /*Multiply matrices to create the reduce matrix Ke_reduced */
    3402         MatrixMultiply(&Kib[0][0],24,3,0,&Kbbinv[0][0],3,3,0,&KibKbbinv[0][0],0);
    3403         MatrixMultiply(&KibKbbinv[0][0],24,3,0,&Pb[0],3,1,0,&Pright[0],0);
    3404 
    3405         /*Affect value to the reduced matrix */
    3406         for(i=0;i<24;i++){
    3407                 *(Pe_reduced+i)=Pi[i]-Pright[i];
    3408         }
    3409 }
    3410 /*}}}*/
    3411 /*FUNCTION Penta GetNodalFunctionsStokes {{{1*/
     3455/*FUNCTION GetNodalFunctionsStokes {{{1*/
    34123456#undef __FUNCT__
    34133457#define __FUNCT__ "Penta::GetNodalFunctionsStokes"
    … …  
    34393483}
    34403484/*}}}*/
    3441 /*FUNCTION Penta CreateKMatrixThermal {{{1*/
    3442 #undef __FUNCT__
    3443 #define __FUNCT__ "Penta::CreateKMatrixThermal"
    3444 void  Penta::CreateKMatrixThermal(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
    3445 
    3446         /* local declarations */
    3447         int i,j;
    3448         int found=0;
    3449 
    3450         /* node data: */
    3451         const int    numgrids=6;
    3452         const int    NDOF1=1;
    3453         const int    numdof=NDOF1*numgrids;
    3454         double xyz_list[numgrids][3];
    3455         int    doflist[numdof];
    3456         int    numberofdofspernode;
    3457 
    3458         /* gaussian points: */
    3459         int     num_area_gauss,igarea,igvert;
    3460         double* first_gauss_area_coord  =  NULL;
    3461         double* second_gauss_area_coord =  NULL;
    3462         double* third_gauss_area_coord  =  NULL;
    3463         double* vert_gauss_coord = NULL;
    3464         double* area_gauss_weights  =  NULL;
    3465         double* vert_gauss_weights  =  NULL;
    3466         double  gauss_weight,area_gauss_weight,vert_gauss_weight;
    3467         double  gauss_coord[4];
    3468         double  gauss_l1l2l3[3];
    3469 
    3470         int area_order=5;
    3471         int num_vert_gauss=5;
    3472 
    3473         int     dofs[3]={0,1,2};
    3474         double  dt;
    3475         double  K[2][2]={0.0};
    3476 
    3477         double  vxvyvz_list[numgrids][3];
    3478         double  vx_list[numgrids];
    3479         int     vx_list_exists;
    3480         double  u;
    3481         double  vy_list[numgrids];
    3482         int     vy_list_exists;
    3483         double  v;
    3484         double  vz_list[numgrids];
    3485         int     vz_list_exists;
    3486         double  w;
    3487 
    3488         /*matrices: */
    3489         double     K_terms[numdof][numdof]={0.0};
    3490         double     Ke_gaussian_conduct[numdof][numdof];
    3491         double     Ke_gaussian_advec[numdof][numdof];
    3492         double     Ke_gaussian_artdiff[numdof][numdof];
    3493         double     Ke_gaussian_transient[numdof][numdof];
    3494         double     B[3][numdof];
    3495         double     Bprime[3][numdof];
    3496         double     B_conduct[3][numdof];
    3497         double     B_advec[3][numdof];
    3498         double     B_artdiff[2][numdof];
    3499         double     Bprime_advec[3][numdof];
    3500         double     L[numdof];
    3501         double     D_scalar;
    3502         double     D[3][3];
    3503         double     l1l2l3[3];
    3504         double     tl1l2l3D[3];
    3505         double     tBD[3][numdof];
    3506         double     tBD_conduct[3][numdof];
    3507         double     tBD_advec[3][numdof];
    3508         double     tBD_artdiff[3][numdof];
    3509         double     tLD[numdof];
    3510 
    3511         double     Jdet;
    3512 
    3513         /*Material properties: */
    3514         double     gravity,rho_ice,rho_water;
    3515         double     heatcapacity,thermalconductivity;
    3516         double     mixed_layer_capacity,thermal_exchange_velocity;
    3517 
    3518         /*Collapsed formulation: */
    3519         Tria*  tria=NULL;
    3520         ParameterInputs* inputs=NULL;
    3521 
    3522         /*If on water, skip: */
    3523         if(onwater)return;
    3524 
    3525         /*recover pointers: */
    3526         inputs=(ParameterInputs*)vinputs;
    3527 
    3528         /* Get node coordinates and dof list: */
    3529         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    3530         GetDofList(&doflist[0],&numberofdofspernode);
    3531 
    3532         // /*recovre material parameters: */
    3533         rho_water=matpar->GetRhoWater();
    3534         rho_ice=matpar->GetRhoIce();
    3535         gravity=matpar->GetG();
    3536         heatcapacity=matpar->GetHeatCapacity();
    3537         thermalconductivity=matpar->GetThermalConductivity();
    3538 
    3539         /*recover extra inputs from users, dt and velocity: */
    3540         found=inputs->Recover("velocity",&vxvyvz_list[0][0],3,dofs,numgrids,(void**)nodes);
    3541         if(!found)throw ErrorException(__FUNCT__," could not find velocity in inputs!");
    3542         found=inputs->Recover("dt",&dt);
    3543         if(!found)throw ErrorException(__FUNCT__," could not find dt in inputs!");
    3544 
    3545         for(i=0;i<numgrids;i++){
    3546                 vx_list[i]=vxvyvz_list[i][0];
    3547                 vy_list[i]=vxvyvz_list[i][1];
    3548                 vz_list[i]=vxvyvz_list[i][2];
    3549         }
    3550 
    3551 
    3552         /* Get gaussian points and weights. Penta is an extrusion of a Tria, we therefore
    3553                 get tria gaussian points as well as segment gaussian points. For tria gaussian
    3554                 points, order of integration is 2, because we need to integrate the product tB*D*B'
    3555                 which is a polynomial of degree 3 (see GaussTria for more details). For segment gaussian
    3556                 points, same deal, which yields 3 gaussian points.: */
    3557 
    3558         /*Get gaussian points: */
    3559         area_order=2;
    3560         num_vert_gauss=2;
    3561 
    3562         GaussPenta( &num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &area_gauss_weights,&vert_gauss_coord, &vert_gauss_weights, area_order, num_vert_gauss);
    3563 
    3564         /* Start  looping on the number of gaussian points: */
    3565         for (igarea=0; igarea<num_area_gauss; igarea++){
    3566                 for (igvert=0; igvert<num_vert_gauss; igvert++){
    3567                         /*Pick up the gaussian point: */
    3568                         area_gauss_weight=*(area_gauss_weights+igarea);
    3569                         vert_gauss_weight=*(vert_gauss_weights+igvert);
    3570                         gauss_weight=area_gauss_weight*vert_gauss_weight;
    3571                         gauss_coord[0]=*(first_gauss_area_coord+igarea);
    3572                         gauss_coord[1]=*(second_gauss_area_coord+igarea);
    3573                         gauss_coord[2]=*(third_gauss_area_coord+igarea);
    3574                         gauss_coord[3]=*(vert_gauss_coord+igvert);
    3575 
    3576                         /* Get Jacobian determinant: */
    3577                         GetJacobianDeterminant(&Jdet, &xyz_list[0][0],gauss_coord);
    3578 
    3579                         /*Conduction: */
    3580 
    3581                         /*Get B_conduct matrix: */
    3582                         GetB_conduct(&B_conduct[0][0],&xyz_list[0][0],gauss_coord);
    3583 
    3584                         /*Build D: */
    3585                         D_scalar=gauss_weight*Jdet*(thermalconductivity/(rho_ice*heatcapacity));
    3586 
    3587                         if(dt){
    3588                                 D_scalar=D_scalar*dt;
    3589                         }
    3590 
    3591                         D[0][0]=D_scalar; D[0][1]=0; D[0][2]=0;
    3592                         D[1][0]=0; D[1][1]=D_scalar; D[1][2]=0;
    3593                         D[2][0]=0; D[2][1]=0; D[2][2]=D_scalar;
    3594 
    3595                         /*  Do the triple product B'*D*B: */
    3596                         MatrixMultiply(&B_conduct[0][0],3,numdof,1,&D[0][0],3,3,0,&tBD_conduct[0][0],0);
    3597                         MatrixMultiply(&tBD_conduct[0][0],numdof,3,0,&B_conduct[0][0],3,numdof,0,&Ke_gaussian_conduct[0][0],0);
    3598 
    3599                         /*Advection: */
    3600 
    3601                         /*Get B_advec and Bprime_advec matrices: */
    3602                         GetB_advec(&B_advec[0][0],&xyz_list[0][0],gauss_coord);
    3603                         GetBprime_advec(&Bprime_advec[0][0],&xyz_list[0][0],gauss_coord);
    3604 
    3605                         //Build the D matrix
    3606                         GetParameterValue(&u, &vx_list[0],gauss_coord);
    3607                         GetParameterValue(&v, &vy_list[0],gauss_coord);
    3608                         GetParameterValue(&w, &vz_list[0],gauss_coord);
    3609 
    3610                         D_scalar=gauss_weight*Jdet;
    3611 
    3612                         if(dt){
    3613                                 D_scalar=D_scalar*dt;
    3614                         }
    3615 
    3616                         D[0][0]=D_scalar*u;D[0][1]=0;         D[0][2]=0;
    3617                         D[1][0]=0;         D[1][1]=D_scalar*v;D[1][2]=0;
    3618                         D[2][0]=0;         D[2][1]=0;         D[2][2]=D_scalar*w;
    3619 
    3620                         /*  Do the triple product B'*D*Bprime: */
    3621                         MatrixMultiply(&B_advec[0][0],3,numdof,1,&D[0][0],3,3,0,&tBD_advec[0][0],0);
    3622                         MatrixMultiply(&tBD_advec[0][0],numdof,3,0,&Bprime_advec[0][0],3,numdof,0,&Ke_gaussian_advec[0][0],0);
    3623 
    3624                         /*Transient: */
    3625                         if(dt){
    3626                                 GetNodalFunctions(&L[0], gauss_coord);
    3627                                 D_scalar=gauss_weight*Jdet;
    3628                                 D_scalar=D_scalar;
    3629 
    3630                                 /*  Do the triple product L'*D*L: */
    3631                                 MatrixMultiply(&L[0],numdof,1,0,&D_scalar,1,1,0,&tLD[0],0);
    3632                                 MatrixMultiply(&tLD[0],numdof,1,0,&L[0],1,numdof,0,&Ke_gaussian_transient[0][0],0);
    3633                         }
    3634                         else{
    3635                                 for(i=0;i<numdof;i++){
    3636                                         for(j=0;j<numdof;j++){
    3637                                                 Ke_gaussian_transient[i][j]=0;
    3638                                         }
    3639                                 }
    3640                         }
    3641 
    3642                         /*Artifficial diffusivity*/
    3643                         if(numpar->artdiff){
    3644                                 /*Build K: */
    3645                                 D_scalar=gauss_weight*Jdet/(pow(u,2)+pow(v,2)+numpar->epsvel);
    3646                                 if(dt){
    3647                                         D_scalar=D_scalar*dt;
    3648                                 }
    3649                                 K[0][0]=D_scalar*pow(u,2);       K[0][1]=D_scalar*fabs(u)*fabs(v);
    3650                                 K[1][0]=D_scalar*fabs(u)*fabs(v);K[1][1]=D_scalar*pow(v,2);
    3651 
    3652                                 /*Get B_artdiff: */
    3653                                 GetB_artdiff(&B_artdiff[0][0],&xyz_list[0][0],gauss_coord);
    3654 
    3655                                 /*  Do the triple product B'*K*B: */
    3656                                 MatrixMultiply(&B_artdiff[0][0],2,numdof,1,&K[0][0],2,2,0,&tBD_artdiff[0][0],0);
    3657                                 MatrixMultiply(&tBD_artdiff[0][0],numdof,2,0,&B_artdiff[0][0],2,numdof,0,&Ke_gaussian_artdiff[0][0],0);
    3658                         }
    3659                         else{
    3660                                 for(i=0;i<numdof;i++){
    3661                                         for(j=0;j<numdof;j++){
    3662                                                 Ke_gaussian_artdiff[i][j]=0;
    3663                                         }
    3664                                 }
    3665                         }
    3666 
    3667                         /*Add Ke_gaussian to pKe: */
    3668                         for(i=0;i<numdof;i++){
    3669                                 for(j=0;j<numdof;j++){
    3670                                         K_terms[i][j]+=Ke_gaussian_conduct[i][j]+Ke_gaussian_advec[i][j]+Ke_gaussian_transient[i][j]+Ke_gaussian_artdiff[i][j];
    3671                                 }
    3672                         }
    3673                 }
    3674         }
    3675 
    3676 
    3677         /*Add Ke_gg to global matrix Kgg: */
    3678         MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)K_terms,ADD_VALUES);
    3679 
    3680 cleanup_and_return:
    3681         xfree((void**)&first_gauss_area_coord);
    3682         xfree((void**)&second_gauss_area_coord);
    3683         xfree((void**)&third_gauss_area_coord);
    3684         xfree((void**)&area_gauss_weights);
    3685         xfree((void**)&vert_gauss_weights);
    3686         xfree((void**)&vert_gauss_coord);
    3687 
    3688         //Ice/ocean heat exchange flux on ice shelf base
    3689         if(onbed && shelf){
    3690 
    3691                 tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
    3692                 tria->CreateKMatrixThermal(Kgg,inputs, analysis_type,sub_analysis_type);
    3693                 delete tria;
    3694         }
    3695 }
    3696 /*}}}*/
    3697 /*FUNCTION Penta GetB_conduct {{{1*/
    3698 #undef __FUNCT__
    3699 #define __FUNCT__ "Penta::GetB_conduct"
    3700 void Penta::GetB_conduct(double* B_conduct, double* xyz_list, double* gauss_coord){
    3701 
    3702         /*Compute B  matrix. B=[B1 B2 B3 B4 B5 B6] where Bi is of size 5*DOFPERGRID.
    3703          * For grid i, Bi' can be expressed in the basic coordinate system
    3704          * by:
    3705          *       Bi_conduct_basic=[ dh/dx ]
    3706          *                       [ dh/dy ]
    3707          *                       [ dh/dz ]
    3708          * where h is the interpolation function for grid i.
     3485/*FUNCTION GetParameterDerivativeValue {{{1*/
     3486#undef __FUNCT__
     3487#define __FUNCT__ "Penta::GetParameterDerivativeValue"
     3488void Penta::GetParameterDerivativeValue(double* p, double* p_list,double* xyz_list, double* gauss_l1l2l3l4){
     3489
     3490        /*From grid values of parameter p (p_list[0], p_list[1], p_list[2], p_list[3], p_list[4] and p_list[4]), return parameter derivative value at gaussian point specified by gauss_l1l2l3l4:
     3491         *   dp/dx=p_list[0]*dh1/dx+p_list[1]*dh2/dx+p_list[2]*dh3/dx+p_list[3]*dh4/dx+p_list[4]*dh5/dx+p_list[5]*dh6/dx;
     3492         *   dp/dy=p_list[0]*dh1/dy+p_list[1]*dh2/dy+p_list[2]*dh3/dy+p_list[3]*dh4/dy+p_list[4]*dh5/dy+p_list[5]*dh6/dy;
     3493         *   dp/dz=p_list[0]*dh1/dz+p_list[1]*dh2/dz+p_list[2]*dh3/dz+p_list[3]*dh4/dz+p_list[4]*dh5/dz+p_list[5]*dh6/dz;
    37093494         *
    3710          * We assume B has been allocated already, of size: 3x(DOFPERGRID*numgrids)
     3495         *   p is a vector of size 3x1 already allocated.
    37113496         */
    37123497
     3498        const int NDOF3=3;
     3499        const int numgrids=6;
     3500        double dh1dh2dh3dh4dh5dh6_basic[NDOF3][numgrids];
     3501
     3502        /*Get dh1dh2dh3dh4dh5dh6_basic in basic coordinate system: */
     3503        GetNodalFunctionsDerivativesBasic(&dh1dh2dh3dh4dh5dh6_basic[0][0],xyz_list, gauss_l1l2l3l4);
     3504
     3505        *(p+0)=p_list[0]*dh1dh2dh3dh4dh5dh6_basic[0][0]+p_list[1]*dh1dh2dh3dh4dh5dh6_basic[0][1]+p_list[2]*dh1dh2dh3dh4dh5dh6_basic[0][2]+p_list[3]*dh1dh2dh3dh4dh5dh6_basic[0][3]+p_list[4]*dh1dh2dh3dh4dh5dh6_basic[0][4]+p_list[5]*dh1dh2dh3dh4dh5dh6_basic[0][5];
     3506        ;
     3507        *(p+1)=p_list[0]*dh1dh2dh3dh4dh5dh6_basic[1][0]+p_list[1]*dh1dh2dh3dh4dh5dh6_basic[1][1]+p_list[2]*dh1dh2dh3dh4dh5dh6_basic[1][2]+p_list[3]*dh1dh2dh3dh4dh5dh6_basic[1][3]+p_list[4]*dh1dh2dh3dh4dh5dh6_basic[1][4]+p_list[5]*dh1dh2dh3dh4dh5dh6_basic[1][5];
     3508
     3509        *(p+2)=p_list[0]*dh1dh2dh3dh4dh5dh6_basic[2][0]+p_list[1]*dh1dh2dh3dh4dh5dh6_basic[2][1]+p_list[2]*dh1dh2dh3dh4dh5dh6_basic[2][2]+p_list[3]*dh1dh2dh3dh4dh5dh6_basic[2][3]+p_list[4]*dh1dh2dh3dh4dh5dh6_basic[2][4]+p_list[5]*dh1dh2dh3dh4dh5dh6_basic[2][5];
     3510
     3511}
     3512/*}}}*/
     3513/*FUNCTION GetParameterValue {{{1*/
     3514#undef __FUNCT__
     3515#define __FUNCT__ "Penta::GetParameterValue"
     3516void Penta::GetParameterValue(double* pvalue, double* v_list,double* gauss_l1l2l3l4){
     3517
     3518        const int numgrids=6;
     3519        double l1l2l3l4l5l6[numgrids];
     3520
     3521        GetNodalFunctions(&l1l2l3l4l5l6[0], gauss_l1l2l3l4);
     3522
     3523        *pvalue=l1l2l3l4l5l6[0]*v_list[0]+l1l2l3l4l5l6[1]*v_list[1]+l1l2l3l4l5l6[2]*v_list[2]+l1l2l3l4l5l6[3]*v_list[3]+l1l2l3l4l5l6[4]*v_list[4]+l1l2l3l4l5l6[5]*v_list[5];
     3524}
     3525/*}}}*/
     3526/*FUNCTION GetJacobianInvert {{{1*/
     3527#undef __FUNCT__
     3528#define __FUNCT__ "Penta::GetJacobianInvert"
     3529void Penta::GetJacobianInvert(double*  Jinv, double* xyz_list,double* gauss_l1l2l3l4){
     3530
     3531        double Jdet;
     3532        const int NDOF3=3;
     3533
     3534        /*Call Jacobian routine to get the jacobian:*/
     3535        GetJacobian(Jinv, xyz_list, gauss_l1l2l3l4);
     3536
     3537        /*Invert Jacobian matrix: */
     3538        MatrixInverse(Jinv,NDOF3,NDOF3,NULL,0,&Jdet);
     3539}
     3540/*}}}*/
     3541/*FUNCTION GetMatPar {{{1*/
     3542void* Penta::GetMatPar(){
     3543        return matpar;
     3544}
     3545/*}}}*/
     3546/*FUNCTION GetNodalFunctions {{{1*/
     3547#undef __FUNCT__
     3548#define __FUNCT__ "Penta::GetNodalFunctions"
     3549void Penta::GetNodalFunctions(double* l1l2l3l4l5l6, double* gauss_l1l2l3l4){
     3550
     3551        /*This routine returns the values of the nodal functions  at the gaussian point.*/
     3552
     3553        l1l2l3l4l5l6[0]=gauss_l1l2l3l4[0]*(1-gauss_l1l2l3l4[3])/2.0;
     3554
     3555        l1l2l3l4l5l6[1]=gauss_l1l2l3l4[1]*(1-gauss_l1l2l3l4[3])/2.0;
     3556
     3557        l1l2l3l4l5l6[2]=gauss_l1l2l3l4[2]*(1-gauss_l1l2l3l4[3])/2.0;
     3558
     3559        l1l2l3l4l5l6[3]=gauss_l1l2l3l4[0]*(1+gauss_l1l2l3l4[3])/2.0;
     3560
     3561        l1l2l3l4l5l6[4]=gauss_l1l2l3l4[1]*(1+gauss_l1l2l3l4[3])/2.0;
     3562
     3563        l1l2l3l4l5l6[5]=gauss_l1l2l3l4[2]*(1+gauss_l1l2l3l4[3])/2.0;
     3564
     3565}
     3566/*}}}*/
     3567/*FUNCTION GetNodes {{{1*/
     3568void  Penta::GetNodes(void** vpnodes){
    37133569        int i;
    3714         const int calculationdof=3;
    3715         const int numgrids=6;
    3716         int DOFPERGRID=1;
    3717 
    3718         /*Same thing in the basic coordinate system: */
    3719         double dh1dh6_basic[calculationdof][numgrids];
    3720 
    3721         /*Get dh1dh2dh3 in basic coordinates system : */
    3722         GetNodalFunctionsDerivativesBasic(&dh1dh6_basic[0][0],xyz_list,gauss_coord);
    3723 
    3724         /*Build B': */
    3725         for (i=0;i<numgrids;i++){
    3726                 *(B_conduct+DOFPERGRID*numgrids*0+DOFPERGRID*i)=dh1dh6_basic[0][i];
    3727                 *(B_conduct+DOFPERGRID*numgrids*1+DOFPERGRID*i)=dh1dh6_basic[1][i];
    3728                 *(B_conduct+DOFPERGRID*numgrids*2+DOFPERGRID*i)=dh1dh6_basic[2][i];
    3729         }
    3730 }
    3731 /*}}}*/
    3732 /*FUNCTION Penta GetB_artdiff {{{1*/
    3733 #undef __FUNCT__
    3734 #define __FUNCT__ "Penta::GetB_artdiff"
    3735 void Penta::GetB_artdiff(double* B_artdiff, double* xyz_list, double* gauss_coord){
    3736 
    3737         /*Compute B  matrix. B=[B1 B2 B3 B4 B5 B6] where Bi is of size 5*DOFPERGRID.
    3738          * For grid i, Bi' can be expressed in the basic coordinate system
    3739          * by:
    3740          *       Bi_artdiff_basic=[ dh/dx ]
    3741          *                       [ dh/dy ]
    3742          * where h is the interpolation function for grid i.
    3743          *
    3744          * We assume B has been allocated already, of size: 2x(DOFPERGRID*numgrids)
    3745          */
    3746 
    3747         int i;
    3748         const int calculationdof=3;
    3749         const int numgrids=6;
    3750         int DOFPERGRID=1;
    3751 
    3752         /*Same thing in the basic coordinate system: */
    3753         double dh1dh6_basic[calculationdof][numgrids];
    3754 
    3755         /*Get dh1dh2dh3 in basic coordinates system : */
    3756         GetNodalFunctionsDerivativesBasic(&dh1dh6_basic[0][0],xyz_list,gauss_coord);
    3757 
    3758         /*Build B': */
    3759         for (i=0;i<numgrids;i++){
    3760                 *(B_artdiff+DOFPERGRID*numgrids*0+DOFPERGRID*i)=dh1dh6_basic[0][i];
    3761                 *(B_artdiff+DOFPERGRID*numgrids*1+DOFPERGRID*i)=dh1dh6_basic[1][i];
    3762         }
    3763 }
    3764 /*}}}*/
    3765 /*FUNCTION Penta GetB_advec {{{1*/
    3766 #undef __FUNCT__
    3767 #define __FUNCT__ "Penta::GetB_advec"
    3768 void Penta::GetB_advec(double* B_advec, double* xyz_list, double* gauss_coord){
    3769 
    3770         /*Compute B  matrix. B=[B1 B2 B3 B4 B5 B6] where Bi is of size 5*DOFPERGRID.
    3771          * For grid i, Bi' can be expressed in the basic coordinate system
    3772          * by:
    3773          *       Bi_advec_basic =[ h ]
    3774          *                       [ h ]
    3775          *                       [ h ]
    3776          * where h is the interpolation function for grid i.
    3777          *
    3778          * We assume B has been allocated already, of size: 3x(DOFPERGRID*numgrids)
    3779          */
    3780 
    3781         int i;
    3782         int calculationdof=3;
    3783         int numgrids=6;
    3784         int DOFPERGRID=1;
    3785 
    3786         /*Same thing in the basic coordinate system: */
    3787         double l1l6[6];
    3788 
    3789         /*Get dh1dh2dh3 in basic coordinates system : */
    3790         GetNodalFunctions(l1l6, gauss_coord);
    3791 
    3792         /*Build B': */
    3793         for (i=0;i<numgrids;i++){
    3794                 *(B_advec+DOFPERGRID*numgrids*0+DOFPERGRID*i)=l1l6[i];
    3795                 *(B_advec+DOFPERGRID*numgrids*1+DOFPERGRID*i)=l1l6[i];
    3796                 *(B_advec+DOFPERGRID*numgrids*2+DOFPERGRID*i)=l1l6[i];
    3797         }
    3798 }
    3799 /*}}}*/
    3800 /*FUNCTION Penta GetBprime_advec {{{1*/
    3801 #undef __FUNCT__
    3802 #define __FUNCT__ "Penta::GetBprime_advec"
    3803 void Penta::GetBprime_advec(double* Bprime_advec, double* xyz_list, double* gauss_coord){
    3804 
    3805 
    3806         /*Compute B  matrix. B=[B1 B2 B3 B4 B5 B6] where Bi is of size 5*DOFPERGRID.
    3807          * For grid i, Bi' can be expressed in the basic coordinate system
    3808          * by:
    3809          *       Biprime_advec=[ dh/dx ]
    3810          *                       [ dh/dy ]
    3811          *                       [ dh/dz ]
    3812          * where h is the interpolation function for grid i.
    3813          *
    3814          * We assume B has been allocated already, of size: 3x(DOFPERGRID*numgrids)
    3815          */
    3816 
    3817         int i;
    3818         const int calculationdof=3;
    3819         const int numgrids=6;
    3820         int DOFPERGRID=1;
    3821 
    3822         /*Same thing in the basic coordinate system: */
    3823         double dh1dh6_basic[calculationdof][numgrids];
    3824 
    3825         /*Get dh1dh2dh3 in basic coordinates system : */
    3826         GetNodalFunctionsDerivativesBasic(&dh1dh6_basic[0][0],xyz_list,gauss_coord);
    3827 
    3828         /*Build B': */
    3829         for (i=0;i<numgrids;i++){
    3830                 *(Bprime_advec+DOFPERGRID*numgrids*0+DOFPERGRID*i)=dh1dh6_basic[0][i];
    3831                 *(Bprime_advec+DOFPERGRID*numgrids*1+DOFPERGRID*i)=dh1dh6_basic[1][i];
    3832                 *(Bprime_advec+DOFPERGRID*numgrids*2+DOFPERGRID*i)=dh1dh6_basic[2][i];
    3833         }
    3834 }
    3835 /*}}}*/
    3836 /*FUNCTION Penta CreateKMatrixMelting {{{1*/
    3837 #undef __FUNCT__
    3838 #define __FUNCT__ "Penta::CreateKMatrixMelting"
    3839 void  Penta::CreateKMatrixMelting(Mat Kgg,void* inputs,int analysis_type,int sub_analysis_type){
    3840 
    3841         Tria* tria=NULL;
    3842 
    3843         /*If on water, skip: */
    3844         if(onwater)return;
    3845 
    3846         if (!onbed){
    3847                 return;
    3848         }
    3849         else{
    3850 
    3851                 tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
    3852                 tria->CreateKMatrixMelting(Kgg,inputs, analysis_type,sub_analysis_type);
    3853                 delete tria;
    3854                 return;
    3855         }
    3856 }
    3857 /*}}}*/
    3858 /*FUNCTION Penta CreatePVectorThermal {{{1*/
    3859 #undef __FUNCT__
    3860 #define __FUNCT__ "Penta::CreatePVectorThermal"
    3861 void Penta::CreatePVectorThermal( Vec pg, void* vinputs,int analysis_type,int sub_analysis_type){
    3862 
    3863 
    3864         /*indexing: */
    3865         int i,j;
    3866         int found=0;
    3867 
    3868         const int  numgrids=6;
    3869         const int  NDOF1=1;
    3870         const int  numdof=numgrids*NDOF1;
    3871         int        doflist[numdof];
    3872         int        numberofdofspernode;
    3873 
    3874         /*Grid data: */
    3875         double        xyz_list[numgrids][3];
    3876 
    3877         /* gaussian points: */
    3878         int     num_area_gauss,igarea,igvert;
    3879         double* first_gauss_area_coord  =  NULL;
    3880         double* second_gauss_area_coord =  NULL;
    3881         double* third_gauss_area_coord  =  NULL;
    3882         double* vert_gauss_coord = NULL;
    3883         double* area_gauss_weights  =  NULL;
    3884         double* vert_gauss_weights  =  NULL;
    3885         double  gauss_weight,area_gauss_weight,vert_gauss_weight;
    3886         double  gauss_coord[4];
    3887         int     area_order=2;
    3888         int       num_vert_gauss=3;
    3889 
    3890         double dt;
    3891         double vx_list[numgrids];
    3892         double vy_list[numgrids];
    3893         double vz_list[numgrids];
    3894         double vxvyvz_list[numgrids][3];
    3895         double temperature_list[numgrids];
    3896         double temperature;
    3897 
    3898         /*Material properties: */
    3899         double gravity,rho_ice,rho_water;
    3900         double mixed_layer_capacity,heatcapacity;
    3901         double beta,meltingpoint,thermal_exchange_velocity;
    3902 
    3903         /* element parameters: */
    3904         int    friction_type;
    3905 
    3906         int    dofs[3]={0,1,2};
    3907         int    dofs1[1]={0};
    3908 
    3909         /*matrices: */
    3910         double P_terms[numdof]={0.0};
    3911         double L[numdof];
    3912         double l1l2l3[3];
    3913         double alpha2_list[3];
    3914         double basalfriction_list[3]={0.0};
    3915         double basalfriction;
    3916         double epsilon[6];
    3917         double epsilon_sqr[3][3];
    3918         double epsilon_matrix[3][3];
    3919 
    3920         double Jdet;
    3921         double viscosity;
    3922         double epsilon_eff;
    3923         double phi;
    3924         double t_pmp;
    3925         double scalar;
    3926         double scalar_def;
    3927         double scalar_ocean;
    3928         double scalar_transient;
    3929 
    3930         /*Collapsed formulation: */
    3931         Tria*  tria=NULL;
    3932         ParameterInputs* inputs=NULL;
    3933 
    3934         /*If on water, skip: */
    3935         if(onwater)return;
    3936 
    3937         /*recover pointers: */
    3938         inputs=(ParameterInputs*)vinputs;
    3939 
    3940         /* Get node coordinates and dof list: */
    3941         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    3942         GetDofList(&doflist[0],&numberofdofspernode);
    3943 
    3944         /*recovre material parameters: */
    3945         rho_water=matpar->GetRhoWater();
    3946         rho_ice=matpar->GetRhoIce();
    3947         gravity=matpar->GetG();
    3948         heatcapacity=matpar->GetHeatCapacity();
    3949         beta=matpar->GetBeta();
    3950         meltingpoint=matpar->GetMeltingPoint();
    3951 
    3952         /*recover extra inputs from users, dt and velocity: */
    3953         found=inputs->Recover("velocity",&vxvyvz_list[0][0],3,dofs,numgrids,(void**)nodes);
    3954         if(!found)throw ErrorException(__FUNCT__," could not find velocity in inputs!");
    3955         found=inputs->Recover("dt",&dt);
    3956         if(!found)throw ErrorException(__FUNCT__," could not find dt in inputs!");
    3957 
    3958         if(dt){
    3959                 found=inputs->Recover("temperature",&temperature_list[0],1,dofs1,numgrids,(void**)nodes);
    3960                 if(!found)throw ErrorException(__FUNCT__," could not find temperature in inputs!");
    3961         }
    3962 
    3963         for(i=0;i<numgrids;i++){
    3964                 vx_list[i]=vxvyvz_list[i][0];
    3965                 vy_list[i]=vxvyvz_list[i][1];
    3966                 vz_list[i]=vxvyvz_list[i][2];
    3967         }       
    3968 
    3969         /* Get gaussian points and weights. Penta is an extrusion of a Tria, we therefore
    3970                 get tria gaussian points as well as segment gaussian points. For tria gaussian
    3971                 points, order of integration is 2, because we need to integrate the product tB*D*B'
    3972                 which is a polynomial of degree 3 (see GaussTria for more details). For segment gaussian
    3973                 points, same deal, which yields 3 gaussian points.: */
    3974 
    3975         /*Get gaussian points: */
    3976         GaussPenta( &num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &area_gauss_weights,&vert_gauss_coord, &vert_gauss_weights, area_order, num_vert_gauss);
    3977 
    3978         /* Start  looping on the number of gaussian points: */
    3979         for (igarea=0; igarea<num_area_gauss; igarea++){
    3980                 for (igvert=0; igvert<num_vert_gauss; igvert++){
    3981                         /*Pick up the gaussian point: */
    3982                         area_gauss_weight=*(area_gauss_weights+igarea);
    3983                         vert_gauss_weight=*(vert_gauss_weights+igvert);
    3984                         gauss_weight=area_gauss_weight*vert_gauss_weight;
    3985                         gauss_coord[0]=*(first_gauss_area_coord+igarea);
    3986                         gauss_coord[1]=*(second_gauss_area_coord+igarea);
    3987                         gauss_coord[2]=*(third_gauss_area_coord+igarea);
    3988                         gauss_coord[3]=*(vert_gauss_coord+igvert);
    3989 
    3990                         /*Compute strain rate and viscosity: */
    3991                         GetStrainRateStokes(&epsilon[0],&vxvyvz_list[0][0],&xyz_list[0][0],gauss_coord);
    3992                         matice->GetViscosity3dStokes(&viscosity,&epsilon[0]);
    3993 
    3994                         /* Get Jacobian determinant: */
    3995                         GetJacobianDeterminant(&Jdet, &xyz_list[0][0],gauss_coord);
    3996 
    3997                         /* Get nodal functions */
    3998                         GetNodalFunctions(&L[0], gauss_coord);
    3999 
    4000                         /*Build deformational heating: */
    4001                         GetPhi(&phi, &epsilon[0], viscosity);
    4002 
    4003                         /*Build pe_gaussian */
    4004                         scalar_def=phi/(rho_ice*heatcapacity)*Jdet*gauss_weight;
    4005                         if(dt){
    4006                                 scalar_def=scalar_def*dt;
    4007                         }
    4008 
    4009                         for(i=0;i<numgrids;i++){
    4010                                 P_terms[i]+=scalar_def*L[i];
    4011                         }
    4012 
    4013                         /* Build transient now */
    4014                         if(dt){
    4015                                 GetParameterValue(&temperature, &temperature_list[0],gauss_coord);
    4016                                 scalar_transient=temperature*Jdet*gauss_weight;
    4017                                 for(i=0;i<numgrids;i++){
    4018                                         P_terms[i]+=scalar_transient*L[i];
    4019                                 }
    4020                         }
    4021                 }
    4022         }
    4023 
    4024         /*Add pe_g to global vector pg: */
    4025         VecSetValues(pg,numdof,doflist,(const double*)P_terms,ADD_VALUES);
    4026 
    4027         /* Ice/ocean heat exchange flux on ice shelf base */
    4028         if(onbed && shelf){
    4029 
    4030                 tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
    4031                 tria->CreatePVectorThermalShelf(pg,inputs, analysis_type,sub_analysis_type);
    4032                 delete tria;
    4033         }
    4034 
    4035         /* Geothermal flux on ice sheet base and basal friction */
    4036         if(onbed && !shelf){
    4037 
    4038                 tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
    4039                 tria->CreatePVectorThermalSheet(pg,inputs, analysis_type,sub_analysis_type);
    4040                 delete tria;
    4041         }
    4042         extern int my_rank;
    4043 
    4044 cleanup_and_return:
    4045         xfree((void**)&first_gauss_area_coord);
    4046         xfree((void**)&second_gauss_area_coord);
    4047         xfree((void**)&third_gauss_area_coord);
    4048         xfree((void**)&vert_gauss_coord);
    4049         xfree((void**)&area_gauss_weights);
    4050         xfree((void**)&vert_gauss_weights);
    4051 
    4052 }
    4053 /*}}}*/
    4054 /*FUNCTION Penta CreatePVectorMelting {{{1*/
    4055 #undef __FUNCT__
    4056 #define __FUNCT__ "Penta::CreatePVectorMelting"
    4057 void Penta::CreatePVectorMelting( Vec pg, void* vinputs,int analysis_type,int sub_analysis_type){
    4058         return;
    4059 }
    4060 /*}}}*/
    4061 /*FUNCTION Penta GetPhi {{{1*/
     3570        Node** pnodes=(Node**)vpnodes;
     3571
     3572        for(i=0;i<6;i++){
     3573                pnodes[i]=nodes[i];
     3574        }
     3575}
     3576/*}}}*/
     3577/*FUNCTION GetOnBed {{{1*/
     3578int Penta::GetOnBed(){
     3579        return onbed;
     3580}
     3581/*}}}*/
     3582/*FUNCTION GetPhi {{{1*/
    40623583#undef __FUNCT__
    40633584#define __FUNCT__ "Penta::GetPhi"
    … …  
    40953616}
    40963617/*}}}*/
    4097 /*FUNCTION Penta MassFlux {{{1*/
     3618/*FUNCTION GetShelf {{{1*/
     3619int   Penta::GetShelf(){
     3620        return shelf;
     3621}
     3622/*}}}*/
     3623/*FUNCTION GetStrainRate {{{1*/
     3624#undef __FUNCT__
     3625#define __FUNCT__ "Penta::GetStrainRate"
     3626void Penta::GetStrainRate(double* epsilon, double* velocity, double* xyz_list, double* gauss_l1l2l3l4){
     3627
     3628        int i;
     3629        const int numgrids=6;
     3630        const int NDOF2=2;
     3631
     3632        double B[5][NDOF2*numgrids];
     3633
     3634        /*Get B matrix: */
     3635        GetB(&B[0][0], xyz_list, gauss_l1l2l3l4);
     3636
     3637#ifdef _ISSM_DEBUG_
     3638        printf("B for grid1 : [ %lf   %lf  \n",B[0][0],B[0][1]);
     3639        printf("              [ %lf   %lf  \n",B[1][0],B[1][1]);
     3640        printf("              [ %lf   %lf  ]\n",B[2][0],B[2][1]);
     3641        printf("              [ %lf   %lf  ]\n",B[3][0],B[3][1]);
     3642        printf("              [ %lf   %lf  ]\n",B[4][0],B[4][1]);
     3643
     3644        printf("B for grid2 : [ %lf   %lf  \n",B[0][2],B[0][3]);
     3645        printf("              [ %lf   %lf  \n",B[1][2],B[1][3]);
     3646        printf("              [ %lf   %lf  ]\n",B[2][2],B[2][3]);
     3647        printf("              [ %lf   %lf  ]\n",B[3][2],B[3][3]);
     3648        printf("              [ %lf   %lf  ]\n",B[4][2],B[4][3]);
     3649
     3650        printf("B for grid3 : [ %lf   %lf  \n", B[0][4],B[0][5]);
     3651        printf("              [ %lf   %lf  \n", B[1][4],B[1][5]);
     3652        printf("              [ %lf   %lf  ]\n",B[2][4],B[2][5]);
     3653        printf("              [ %lf   %lf  ]\n",B[3][4],B[3][5]);
     3654        printf("              [ %lf   %lf  ]\n",B[4][4],B[4][5]);
     3655
     3656        printf("B for grid4 : [ %lf   %lf  \n", B[0][6],B[0][7]);
     3657        printf("              [ %lf   %lf  \n", B[1][6],B[1][7]);
     3658        printf("              [ %lf   %lf  ]\n",B[2][6],B[2][7]);
     3659        printf("              [ %lf   %lf  ]\n",B[3][6],B[3][7]);
     3660        printf("              [ %lf   %lf  ]\n",B[4][6],B[4][7]);
     3661
     3662        printf("B for grid5 : [ %lf   %lf  \n", B[0][8],B[0][9]);
     3663        printf("              [ %lf   %lf  \n", B[1][8],B[1][9]);
     3664        printf("              [ %lf   %lf  ]\n",B[2][8],B[2][9]);
     3665        printf("              [ %lf   %lf  ]\n",B[3][8],B[3][9]);
     3666        printf("              [ %lf   %lf  ]\n",B[4][8],B[4][9]);
     3667
     3668        printf("B for grid6 : [ %lf   %lf  \n", B[0][10],B[0][11]);
     3669        printf("              [ %lf   %lf  \n", B[1][10],B[1][11]);
     3670        printf("              [ %lf   %lf  ]\n",B[2][10],B[2][11]);
     3671        printf("              [ %lf   %lf  ]\n",B[3][10],B[3][11]);
     3672        printf("              [ %lf   %lf  ]\n",B[4][10],B[4][11]);
     3673
     3674#endif
     3675
     3676        /*Multiply B by velocity, to get strain rate: */
     3677        MatrixMultiply( &B[0][0],5,NDOF2*numgrids,0,
     3678                                velocity,NDOF2*numgrids,1,0,
     3679                                epsilon,0);
     3680
     3681}
     3682/*}}}*/
     3683/*FUNCTION GetStrainRateStokes {{{1*/
     3684#undef __FUNCT__
     3685#define __FUNCT__ "Penta::GetStrainRateStokes"
     3686void Penta::GetStrainRateStokes(double* epsilon, double* velocity, double* xyz_list, double* gauss_coord){
     3687
     3688        int i,j;
     3689
     3690        const int numgrids=6;
     3691        const int DOFVELOCITY=3;
     3692        double B[8][27];
     3693        double B_reduced[numgrids][DOFVELOCITY*numgrids];
     3694
     3695        /*Get B matrix: */
     3696        GetBStokes(&B[0][0], xyz_list, gauss_coord);
     3697
     3698        /*Create a reduced matrix of B to get rid of pressure */
     3699        for (i=0;i<6;i++){
     3700                for (j=0;j<3;j++){
     3701                        B_reduced[i][j]=B[i][j];
     3702                }
     3703                for (j=4;j<7;j++){
     3704                        B_reduced[i][j-1]=B[i][j];
     3705                }
     3706                for (j=8;j<11;j++){
     3707                        B_reduced[i][j-2]=B[i][j];
     3708                }
     3709                for (j=12;j<15;j++){
     3710                        B_reduced[i][j-3]=B[i][j];
     3711                }
     3712                for (j=16;j<19;j++){
     3713                        B_reduced[i][j-4]=B[i][j];
     3714                }
     3715                for (j=20;j<23;j++){
     3716                        B_reduced[i][j-5]=B[i][j];
     3717                }
     3718        }
     3719        /*Multiply B by velocity, to get strain rate: */
     3720        MatrixMultiply( &B_reduced[0][0],6,DOFVELOCITY*numgrids, 0, velocity,DOFVELOCITY*numgrids,1,0,epsilon, 0);
     3721}
     3722/*}}}*/
     3723/*FUNCTION GetThicknessList {{{1*/
     3724void Penta::GetThicknessList(double* thickness_list){
     3725
     3726        int i;
     3727        for(i=0;i<6;i++)thickness_list[i]=h[i];
     3728}
     3729/*}}}*/
     3730/*FUNCTION Gradj {{{1*/
     3731#undef __FUNCT__
     3732#define __FUNCT__ "Penta::Gradj"
     3733void  Penta::Gradj(Vec grad_g,void* inputs,int analysis_type,int sub_analysis_type,char* control_type){
     3734
     3735        /*If on water, skip grad (=0): */
     3736        if(onwater)return;
     3737
     3738        if (strcmp(control_type,"drag")==0){
     3739                GradjDrag( grad_g,inputs,analysis_type,sub_analysis_type);
     3740        }
     3741        else if (strcmp(control_type,"B")==0){
     3742                GradjB( grad_g, inputs,analysis_type,sub_analysis_type);
     3743        }
     3744        else throw ErrorException(__FUNCT__,exprintf("%s%s","control type not supported yet: ",control_type));
     3745}
     3746/*}}}*/
     3747/*FUNCTION GradjDrag {{{1*/
     3748#undef __FUNCT__
     3749#define __FUNCT__ "Penta::GradjDrag"
     3750void  Penta::GradjDrag(Vec grad_g,void* inputs,int analysis_type,int sub_analysis_type){
     3751
     3752        Tria* tria=NULL;
     3753
     3754        /*If on water, skip: */
     3755        if(onwater)return;
     3756
     3757        /*If on shelf, skip: */
     3758        if(shelf)return;
     3759
     3760        /*Bail out if this element does not touch the bedrock: */
     3761        if (!onbed) return;
     3762
     3763        if (sub_analysis_type==HorizAnalysisEnum()){
     3764
     3765                /*MacAyeal or Pattyn*/
     3766                tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
     3767                tria->GradjDrag( grad_g,inputs,analysis_type,sub_analysis_type);
     3768                delete tria;
     3769                return;
     3770        }
     3771        else if (sub_analysis_type==StokesAnalysisEnum()){
     3772
     3773                /*Stokes*/
     3774                tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria.
     3775                tria->GradjDragStokes( grad_g,inputs,analysis_type,sub_analysis_type);
     3776                delete tria;
     3777                return;
     3778        }
     3779        else throw ErrorException(__FUNCT__,exprintf("%s%i%s\n","sub_analysis: ",sub_analysis_type," not supported yet"));
     3780}
     3781/*}}}*/
     3782/*FUNCTION GradjB {{{1*/
     3783#undef __FUNCT__
     3784#define __FUNCT__ "Penta::GradjB"
     3785void  Penta::GradjB(Vec grad_g,void* inputs,int analysis_type,int sub_analysis_type){
     3786
     3787        Tria* tria=NULL;
     3788
     3789        /*If on water, skip: */
     3790        if(onwater)return;
     3791
     3792        if (collapse){
     3793                /*Bail out element if collapsed (2d) and not on bed*/
     3794                if (!onbed) return;
     3795
     3796                /*This element should be collapsed into a tria element at its base. Create this tria element,
     3797                 * and compute gardj*/
     3798                tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria (lower face).
     3799                tria->GradjB(grad_g,inputs,analysis_type,sub_analysis_type);
     3800                delete tria;
     3801                return;
     3802        }
     3803        else{
     3804                /*B is a 2d field, use MacAyeal(2d) gradient even if it is Stokes or Pattyn*/
     3805                tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria (lower face).
     3806                tria->GradjB(grad_g,inputs,analysis_type,sub_analysis_type);
     3807                delete tria;
     3808                return;
     3809        }
     3810}
     3811/*}}}*/
     3812/*FUNCTION MassFlux {{{1*/
    40983813#undef __FUNCT__
    40993814#define __FUNCT__ "Penta::MassFlux"
    … …  
    41023817}
    41033818/*}}}*/
     3819/*FUNCTION Misfit {{{1*/
     3820#undef __FUNCT__
     3821#define __FUNCT__ "Penta::Misfit"
     3822double Penta::Misfit(void* inputs,int analysis_type,int sub_analysis_type){
     3823
     3824        double J;
     3825        Tria* tria=NULL;
     3826
     3827        /*If on water, return 0: */
     3828        if(onwater)return 0;
     3829
     3830        /*Bail out if this element if:
     3831         * -> Non collapsed and not on the surface
     3832         * -> collapsed (2d model) and not on bed) */
     3833        if ((!collapse && !onsurface) || (collapse && !onbed)){
     3834                return 0;
     3835        }
     3836        else if (collapse){
     3837
     3838                /*This element should be collapsed into a tria element at its base. Create this tria element,
     3839                 * and compute Misfit*/
     3840                tria=(Tria*)SpawnTria(0,1,2); //grids 0, 1 and 2 make the new tria (lower face).
     3841                J=tria->Misfit(inputs,analysis_type,sub_analysis_type);
     3842                delete tria;
     3843                return J;
     3844        }
     3845        else{
     3846
     3847                tria=(Tria*)SpawnTria(3,4,5); //grids 3, 4 and 5 make the new tria (upper face).
     3848                J=tria->Misfit(inputs,analysis_type,sub_analysis_type);
     3849                delete tria;
     3850                return J;
     3851        }
     3852}
     3853/*}}}*/
     3854/*FUNCTION MyRank {{{1*/
     3855int    Penta::MyRank(void){
     3856        extern int my_rank;
     3857        return my_rank;
     3858}
     3859/*}}}*/
     3860/*FUNCTION ReduceMatrixStokes {{{1*/
     3861#undef __FUNCT__
     3862#define __FUNCT__ "ReduceMatrixStokes"
     3863void Penta::ReduceMatrixStokes(double* Ke_reduced, double* Ke_temp){
     3864
     3865        int i,j;
     3866
     3867        double Kii[24][24];
     3868        double Kib[24][3];
     3869        double Kbb[3][3];
     3870        double Kbi[3][24];
     3871        double Kbbinv[3][3];
     3872        double KibKbbinv[24][3];
     3873        double Kright[24][24];
     3874
     3875        /*Create the four matrices used for reduction */
     3876        for(i=0;i<24;i++){
     3877                for(j=0;j<24;j++){
     3878                        Kii[i][j]=*(Ke_temp+27*i+j);
     3879                }
     3880                for(j=0;j<3;j++){
     3881                        Kib[i][j]=*(Ke_temp+27*i+j+24);
     3882                }
     3883        }
     3884        for(i=0;i<3;i++){
     3885                for(j=0;j<24;j++){
     3886                        Kbi[i][j]=*(Ke_temp+27*(i+24)+j);
     3887                }
     3888                for(j=0;j<3;j++){
     3889                        Kbb[i][j]=*(Ke_temp+27*(i+24)+j+24);
     3890                }
     3891        }
     3892
     3893        /*Inverse the matrix corresponding to bubble part Kbb */
     3894        GetMatrixInvert(&Kbbinv[0][0], &Kbb[0][0]);
     3895
     3896        /*Multiply matrices to create the reduce matrix Ke_reduced */
     3897        MatrixMultiply(&Kib[0][0],24,3,0,&Kbbinv[0][0],3,3,0,&KibKbbinv[0][0],0);
     3898        MatrixMultiply(&KibKbbinv[0][0],24,3,0,&Kbi[0][0],3,24,0,&Kright[0][0],0);
     3899
     3900        /*Affect value to the reduced matrix */
     3901        for(i=0;i<24;i++){
     3902                for(j=0;j<24;j++){
     3903                        *(Ke_reduced+24*i+j)=Kii[i][j]-Kright[i][j];
     3904                }
     3905        }
     3906}
     3907/*}}}*/
     3908/*FUNCTION ReduceVectorStokes {{{1*/
     3909#undef __FUNCT__
     3910#define __FUNCT__ "Penta::ReduceVectorStokes"
     3911void Penta::ReduceVectorStokes(double* Pe_reduced, double* Ke_temp, double* Pe_temp){
     3912
     3913        int i,j;
     3914
     3915        double Pi[24];
     3916        double Pb[3];
     3917        double Kbb[3][3];
     3918        double Kib[24][3];
     3919        double Kbbinv[3][3];
     3920        double KibKbbinv[24][3];
     3921        double Pright[24];
     3922
     3923        /*Create the four matrices used for reduction */
     3924        for(i=0;i<24;i++){
     3925                Pi[i]=*(Pe_temp+i);
     3926        }
     3927        for(i=0;i<3;i++){
     3928                Pb[i]=*(Pe_temp+i+24);
     3929        }
     3930        for(j=0;j<3;j++){
     3931                for(i=0;i<24;i++){
     3932                        Kib[i][j]=*(Ke_temp+3*i+j);
     3933                }
     3934                for(i=0;i<3;i++){
     3935                        Kbb[i][j]=*(Ke_temp+3*(i+24)+j);
     3936                }
     3937        }
     3938
     3939        /*Inverse the matrix corresponding to bubble part Kbb */
     3940        GetMatrixInvert(&Kbbinv[0][0], &Kbb[0][0]);
     3941
     3942        /*Multiply matrices to create the reduce matrix Ke_reduced */
     3943        MatrixMultiply(&Kib[0][0],24,3,0,&Kbbinv[0][0],3,3,0,&KibKbbinv[0][0],0);
     3944        MatrixMultiply(&KibKbbinv[0][0],24,3,0,&Pb[0],3,1,0,&Pright[0],0);
     3945
     3946        /*Affect value to the reduced matrix */
     3947        for(i=0;i<24;i++){
     3948                *(Pe_reduced+i)=Pi[i]-Pright[i];
     3949        }
     3950}
     3951/*}}}*/
     3952/*FUNCTION SpawnTria {{{1*/
     3953#undef __FUNCT__
     3954#define __FUNCT__ "Penta::SpawnTria"
     3955void*  Penta::SpawnTria(int g0, int g1, int g2){
     3956
     3957        /*out of grids g0,g1 and g2 from Penta, build a tria element: */
     3958        Tria* tria=NULL;
     3959        double   tria_h[3];
     3960        double   tria_s[3];
     3961        double   tria_b[3];
     3962        double   tria_c[3];
     3963        double   tria_k[3];
     3964        double   tria_melting[3];
     3965        double   tria_accumulation[3];
     3966        double   tria_geothermalflux[3];
     3967
     3968        /*configuration: */
     3969        int tria_node_ids[3];
     3970        Node* tria_nodes[3];
     3971        int tria_node_offsets[3];
     3972
     3973        tria_h[0]=h[g0];
     3974        tria_h[1]=h[g1];
     3975        tria_h[2]=h[g2];
     3976
     3977        tria_s[0]=s[g0];
     3978        tria_s[1]=s[g1];
     3979        tria_s[2]=s[g2];
     3980
     3981        tria_b[0]=b[g0];
     3982        tria_b[1]=b[g1];
     3983        tria_b[2]=b[g2];
     3984
     3985        tria_k[0]=k[g0];
     3986        tria_k[1]=k[g1];
     3987        tria_k[2]=k[g2];
     3988
     3989        tria_melting[0]=melting[g0];
     3990        tria_melting[1]=melting[g1];
     3991        tria_melting[2]=melting[g2];
     3992
     3993        tria_accumulation[0]=accumulation[g0];
     3994        tria_accumulation[1]=accumulation[g1];
     3995        tria_accumulation[2]=accumulation[g2];
     3996
     3997        tria_geothermalflux[0]=geothermalflux[g0];
     3998        tria_geothermalflux[1]=geothermalflux[g1];
     3999        tria_geothermalflux[2]=geothermalflux[g2];
     4000
     4001        tria_node_ids[0]=node_ids[g0];
     4002        tria_node_ids[1]=node_ids[g1];
     4003        tria_node_ids[2]=node_ids[g2];
     4004
     4005        tria_nodes[0]=nodes[g0];
     4006        tria_nodes[1]=nodes[g1];
     4007        tria_nodes[2]=nodes[g2];
     4008
     4009        tria_node_offsets[0]=node_offsets[g0];
     4010        tria_node_offsets[1]=node_offsets[g1];
     4011        tria_node_offsets[2]=node_offsets[g2];
     4012
     4013        tria= new Tria(id,mid,mparid,numparid,tria_node_ids,tria_h,tria_s,tria_b,tria_k, tria_melting, tria_accumulation, tria_geothermalflux,friction_type,p,q,shelf,onwater);
     4014
     4015        tria->NodeConfiguration(tria_node_ids,tria_nodes,tria_node_offsets);
     4016        tria->MaticeConfiguration(matice,matice_offset);
     4017        tria->MatparConfiguration(matpar,matpar_offset);
     4018        tria->NumparConfiguration(numpar,numpar_offset);
     4019
     4020        return tria;
     4021
     4022}
     4023/*}}}*/
     4024/*FUNCTION UpdateFromInputs {{{1*/
     4025#undef __FUNCT__
     4026#define __FUNCT__ "Penta::UpdateFromInputs"
     4027void  Penta::UpdateFromInputs(void* vinputs){
     4028
     4029        int     dofs[1]={0};
     4030        double  temperature_list[6];
     4031        double  temperature_average;
     4032        double  B_list[6];
     4033        double  B_average;
     4034
     4035        ParameterInputs* inputs=NULL;
     4036
     4037        /*If on water, skip: */
     4038        if(onwater)return;
     4039
     4040        /*recover pointers: */
     4041        inputs=(ParameterInputs*)vinputs;
     4042
     4043        /*Update internal data if inputs holds new values: */
     4044        inputs->Recover("thickness",&h[0],1,dofs,6,(void**)nodes);
     4045        inputs->Recover("surface",&s[0],1,dofs,6,(void**)nodes);
     4046        inputs->Recover("bed",&b[0],1,dofs,6,(void**)nodes);
     4047        inputs->Recover("drag",&k[0],1,dofs,6,(void**)nodes);
     4048        inputs->Recover("melting",&melting[0],1,dofs,6,(void**)nodes);
     4049        inputs->Recover("accumulation_param",&accumulation[0],1,dofs,6,(void**)nodes);
     4050
     4051        //Update material if necessary
     4052        if(inputs->Recover("temperature",&temperature_list[0],1,dofs,6,(void**)nodes)){
     4053                if(matice && !collapse){
     4054                        //B_average=(Paterson(temperature_list[0])+Paterson(temperature_list[1])+Paterson(temperature_list[2])
     4055                        //                      +Paterson(temperature_list[3])+Paterson(temperature_list[4])+Paterson(temperature_list[5]))/6.0;
     4056                        temperature_average=(temperature_list[0]+temperature_list[1]+temperature_list[2]+temperature_list[3]+temperature_list[4]+temperature_list[5])/6.0;
     4057                        B_average=Paterson(temperature_average);
     4058                        matice->SetB(B_average);
     4059                }
     4060        }
     4061
     4062        if(inputs->Recover("temperature_average",&temperature_list[0],1,dofs,6,(void**)nodes)){
     4063                if(matice && collapse){
     4064                        temperature_average=(temperature_list[0]+temperature_list[1]+temperature_list[2]+temperature_list[3]+temperature_list[4]+temperature_list[5])/6.0;
     4065                        B_average=Paterson(temperature_average);
     4066                        //B_average=(Paterson(temperature_list[0])+Paterson(temperature_list[1])+Paterson(temperature_list[2])
     4067                        //                      +Paterson(temperature_list[3])+Paterson(temperature_list[4])+Paterson(temperature_list[5]))/6.0;
     4068                        matice->SetB(B_average);
     4069                }
     4070        }
     4071
     4072        if(inputs->Recover("B",&B_list[0],1,dofs,6,(void**)nodes)){
     4073                if(matice){
     4074                        B_average=(B_list[0]+B_list[1]+B_list[2]+B_list[3]+B_list[4]+B_list[5])/6.0;
     4075                        matice->SetB(B_average);
     4076                }
     4077        }
     4078
     4079}
     4080/*}}}*/
     4081/*FUNCTION SurfaceNormal {{{1*/
     4082#undef __FUNCT__
     4083#define __FUNCT__ "Penta::SurfaceNormal"
     4084void Penta::SurfaceNormal(double* surface_normal, double xyz_list[3][3]){
     4085
     4086        int i;
     4087        double v13[3];
     4088        double v23[3];
     4089        double normal[3];
     4090        double normal_norm;
     4091
     4092        for (i=0;i<3;i++){
     4093                v13[i]=xyz_list[0][i]-xyz_list[2][i];
     4094                v23[i]=xyz_list[1][i]-xyz_list[2][i];
     4095        }
     4096
     4097        normal[0]=v13[1]*v23[2]-v13[2]*v23[1];
     4098        normal[1]=v13[2]*v23[0]-v13[0]*v23[2];
     4099        normal[2]=v13[0]*v23[1]-v13[1]*v23[0];
     4100
     4101        normal_norm=sqrt( pow(normal[0],2)+pow(normal[1],2)+pow(normal[2],2) );
     4102
     4103        *(surface_normal)=normal[0]/normal_norm;
     4104        *(surface_normal+1)=normal[1]/normal_norm;
     4105        *(surface_normal+2)=normal[2]/normal_norm;
     4106
     4107}
     4108/*}}}*/

  • issm/trunk/src/c/objects/Tria.cpp

    r2711 r2713  
    2424//#define _DEBUGGAUSS_
    2525
     26/*Object constructors and destructor*/
    2627/*FUNCTION Tria constructor {{{1*/
    2728Tria::Tria(){
    … …  
    7273}
    7374/*}}}*/
    74 /*FUNCTION Echo {{{1*/
     75
     76/*Object marshall*/
     77/*FUNCTION Marshall {{{1*/
     78void  Tria::Marshall(char** pmarshalled_dataset){
     79
     80        char* marshalled_dataset=NULL;
     81        int   enum_type=0;
     82
     83        /*recover marshalled_dataset: */
     84        marshalled_dataset=*pmarshalled_dataset;
     85
     86        /*get enum type of Tria: */
     87        enum_type=TriaEnum();
     88
     89        /*marshall enum: */
     90        memcpy(marshalled_dataset,&enum_type,sizeof(enum_type));marshalled_dataset+=sizeof(enum_type);
     91
     92        /*marshall Tria data: */
     93        memcpy(marshalled_dataset,&id,sizeof(id));marshalled_dataset+=sizeof(id);
     94        memcpy(marshalled_dataset,&mid,sizeof(mid));marshalled_dataset+=sizeof(mid);
     95        memcpy(marshalled_dataset,&mparid,sizeof(mparid));marshalled_dataset+=sizeof(mparid);
     96        memcpy(marshalled_dataset,&node_ids,sizeof(node_ids));marshalled_dataset+=sizeof(node_ids);
     97        memcpy(marshalled_dataset,&nodes,sizeof(nodes));marshalled_dataset+=sizeof(nodes);
     98        memcpy(marshalled_dataset,&node_offsets,sizeof(node_offsets));marshalled_dataset+=sizeof(node_offsets);
     99        memcpy(marshalled_dataset,&matice,sizeof(matice));marshalled_dataset+=sizeof(matice);
     100        memcpy(marshalled_dataset,&matice_offset,sizeof(matice_offset));marshalled_dataset+=sizeof(matice_offset);
     101        memcpy(marshalled_dataset,&matpar,sizeof(matpar));marshalled_dataset+=sizeof(matpar);
     102        memcpy(marshalled_dataset,&matpar_offset,sizeof(matpar_offset));marshalled_dataset+=sizeof(matpar_offset);
     103        memcpy(marshalled_dataset,&numparid,sizeof(numparid));marshalled_dataset+=sizeof(numparid);
     104        memcpy(marshalled_dataset,&numpar,sizeof(numpar));marshalled_dataset+=sizeof(numpar);
     105        memcpy(marshalled_dataset,&numpar_offset,sizeof(numpar_offset));marshalled_dataset+=sizeof(numpar_offset);
     106        memcpy(marshalled_dataset,&h,sizeof(h));marshalled_dataset+=sizeof(h);
     107        memcpy(marshalled_dataset,&s,sizeof(s));marshalled_dataset+=sizeof(s);
     108        memcpy(marshalled_dataset,&b,sizeof(b));marshalled_dataset+=sizeof(b);
     109        memcpy(marshalled_dataset,&k,sizeof(k));marshalled_dataset+=sizeof(k);
     110        memcpy(marshalled_dataset,&melting,sizeof(melting));marshalled_dataset+=sizeof(melting);
     111        memcpy(marshalled_dataset,&accumulation,sizeof(accumulation));marshalled_dataset+=sizeof(accumulation);
     112        memcpy(marshalled_dataset,&geothermalflux,sizeof(geothermalflux));marshalled_dataset+=sizeof(geothermalflux);
     113        memcpy(marshalled_dataset,&friction_type,sizeof(friction_type));marshalled_dataset+=sizeof(friction_type);
     114        memcpy(marshalled_dataset,&onbed,sizeof(onbed));marshalled_dataset+=sizeof(onbed);
     115        memcpy(marshalled_dataset,&onwater,sizeof(onwater));marshalled_dataset+=sizeof(onwater);
     116        memcpy(marshalled_dataset,&p,sizeof(p));marshalled_dataset+=sizeof(p);
     117        memcpy(marshalled_dataset,&q,sizeof(q));marshalled_dataset+=sizeof(q);
     118        memcpy(marshalled_dataset,&shelf,sizeof(shelf));marshalled_dataset+=sizeof(shelf);
     119
     120        *pmarshalled_dataset=marshalled_dataset;
     121        return;
     122}
     123/*}}}*/
     124/*FUNCTION MarshallSize {{{1*/
     125int   Tria::MarshallSize(){
     126        return sizeof(id)
     127          +sizeof(mid)
     128          +sizeof(mparid)
     129          +sizeof(node_ids)
     130          +sizeof(nodes)
     131          +sizeof(node_offsets)
     132          +sizeof(matice)
     133          +sizeof(matice_offset)
     134          +sizeof(matpar)
     135          +sizeof(matpar_offset)
     136          +sizeof(numparid)
     137          +sizeof(numpar)
     138          +sizeof(numpar_offset)
     139          +sizeof(h)
     140          +sizeof(s)
     141          +sizeof(b)
     142          +sizeof(k)
     143          +sizeof(melting)
     144          +sizeof(accumulation)
     145          +sizeof(geothermalflux)
     146          +sizeof(friction_type)
     147          +sizeof(onbed)
     148          +sizeof(onwater)
     149          +sizeof(p)
     150          +sizeof(q)
     151          +sizeof(shelf)
     152          +sizeof(int); //sizeof(int) for enum type
     153}
     154/*}}}*/
     155/*FUNCTION Demarshall {{{1*/
     156void  Tria::Demarshall(char** pmarshalled_dataset){
     157
     158        char* marshalled_dataset=NULL;
     159        int   i;
     160
     161        /*recover marshalled_dataset: */
     162        marshalled_dataset=*pmarshalled_dataset;
     163
     164        /*this time, no need to get enum type, the pointer directly points to the beginning of the
     165         *object data (thanks to DataSet::Demarshall):*/
     166
     167        memcpy(&id,marshalled_dataset,sizeof(id));marshalled_dataset+=sizeof(id);
     168        memcpy(&mid,marshalled_dataset,sizeof(mid));marshalled_dataset+=sizeof(mid);
     169        memcpy(&mparid,marshalled_dataset,sizeof(mparid));marshalled_dataset+=sizeof(mparid);
     170        memcpy(&node_ids,marshalled_dataset,sizeof(node_ids));marshalled_dataset+=sizeof(node_ids);
     171        memcpy(&nodes,marshalled_dataset,sizeof(nodes));marshalled_dataset+=sizeof(nodes);
     172        memcpy(&node_offsets,marshalled_dataset,sizeof(node_offsets));marshalled_dataset+=sizeof(node_offsets);
     173        memcpy(&matice,marshalled_dataset,sizeof(matice));marshalled_dataset+=sizeof(matice);
     174        memcpy(&matice_offset,marshalled_dataset,sizeof(matice_offset));marshalled_dataset+=sizeof(matice_offset);
     175        memcpy(&matpar,marshalled_dataset,sizeof(matpar));marshalled_dataset+=sizeof(matpar);
     176        memcpy(&matpar_offset,marshalled_dataset,sizeof(matpar_offset));marshalled_dataset+=sizeof(matpar_offset);
     177        memcpy(&numparid,marshalled_dataset,sizeof(numparid));marshalled_dataset+=sizeof(numparid);
     178        memcpy(&numpar,marshalled_dataset,sizeof(numpar));marshalled_dataset+=sizeof(numpar);
     179        memcpy(&numpar_offset,marshalled_dataset,sizeof(numpar_offset));marshalled_dataset+=sizeof(numpar_offset);
     180        memcpy(&h,marshalled_dataset,sizeof(h));marshalled_dataset+=sizeof(h);
     181        memcpy(&s,marshalled_dataset,sizeof(s));marshalled_dataset+=sizeof(s);
     182        memcpy(&b,marshalled_dataset,sizeof(b));marshalled_dataset+=sizeof(b);
     183        memcpy(&k,marshalled_dataset,sizeof(k));marshalled_dataset+=sizeof(k);
     184        memcpy(&melting,marshalled_dataset,sizeof(melting));marshalled_dataset+=sizeof(melting);
     185        memcpy(&accumulation,marshalled_dataset,sizeof(accumulation));marshalled_dataset+=sizeof(accumulation);
     186        memcpy(&geothermalflux,marshalled_dataset,sizeof(geothermalflux));marshalled_dataset+=sizeof(geothermalflux);
     187        memcpy(&friction_type,marshalled_dataset,sizeof(friction_type));marshalled_dataset+=sizeof(friction_type);
     188        memcpy(&onbed,marshalled_dataset,sizeof(onbed));marshalled_dataset+=sizeof(onbed);
     189        memcpy(&onwater,marshalled_dataset,sizeof(onwater));marshalled_dataset+=sizeof(onwater);
     190        memcpy(&p,marshalled_dataset,sizeof(p));marshalled_dataset+=sizeof(p);
     191        memcpy(&q,marshalled_dataset,sizeof(q));marshalled_dataset+=sizeof(q);
     192        memcpy(&shelf,marshalled_dataset,sizeof(shelf));marshalled_dataset+=sizeof(shelf);
     193
     194        /*nodes and materials are not pointing to correct objects anymore:*/
     195        for(i=0;i<3;i++)nodes[i]=NULL;
     196        matice=NULL;
     197        matpar=NULL;
     198        numpar=NULL;
     199
     200        /*return: */
     201        *pmarshalled_dataset=marshalled_dataset;
     202        return;
     203}
     204/*}}}*/
     205
     206/*Object functions*/
     207/*FUNCTION ComputePressure {{{1*/
     208#undef __FUNCT__
     209#define __FUNCT__ "Tria::ComputePressure"
     210void  Tria::ComputePressure(Vec pg){
     211
     212        int i;
     213        const int numgrids=3;
     214        int doflist[numgrids];
     215        double pressure[numgrids];
     216        double rho_ice,g;
     217
     218        /*Get dof list on which we will plug the pressure values: */
     219        GetDofList1(&doflist[0]);
     220
     221        /*pressure is lithostatic: */
     222        rho_ice=matpar->GetRhoIce();
     223        g=matpar->GetG();
     224        for(i=0;i<numgrids;i++){
     225                pressure[i]=rho_ice*g*h[i];
     226        }
     227
     228        /*plug local pressure values into global pressure vector: */
     229        VecSetValues(pg,numgrids,doflist,(const double*)pressure,INSERT_VALUES);
     230
     231}
     232/*}}}*/
     233/*FUNCTION Configure {{{1*/
     234#undef __FUNCT__
     235#define __FUNCT__ "Tria::Configure"
     236void  Tria::Configure(void* ploadsin,void* pnodesin,void* pmaterialsin,void* pparametersin){
     237
     238        int i;
     239
     240        DataSet* loadsin=NULL;
     241        DataSet* nodesin=NULL;
     242        DataSet* materialsin=NULL;
     243        DataSet* parametersin=NULL;
     244
     245        /*Recover pointers :*/
     246        loadsin=(DataSet*)ploadsin;
     247        nodesin=(DataSet*)pnodesin;
     248        materialsin=(DataSet*)pmaterialsin;
     249        parametersin=(DataSet*)pparametersin;
     250
     251        /*Link this element with its nodes, ie find pointers to the nodes in the nodes dataset.: */
     252        ResolvePointers((Object**)nodes,node_ids,node_offsets,3,nodesin);
     253
     254        /*Same for materials: */
     255        ResolvePointers((Object**)&matice,&mid,&matice_offset,1,materialsin);
     256        ResolvePointers((Object**)&matpar,&mparid,&matpar_offset,1,materialsin);
     257
     258        /*Same for numpar: */
     259        ResolvePointers((Object**)&numpar,&numparid,&numpar_offset,1,parametersin);
     260
     261}
     262/*}}}*/
     263/*FUNCTION copy {{{1*/
     264Object* Tria::copy() {
     265
     266        return new Tria(*this);
     267
     268}
     269/*}}}*/
     270/*FUNCTION CreateKMatrix {{{1*/
     271#undef __FUNCT__
     272#define __FUNCT__ "Tria::CreateKMatrix"
     273
     274void  Tria::CreateKMatrix(Mat Kgg,void* inputs,int analysis_type,int sub_analysis_type){
     275
     276        /*Just branch to the correct element stiffness matrix generator, according to the type of analysis we are carrying out: */
     277        if (analysis_type==ControlAnalysisEnum()){
     278               
     279                CreateKMatrixDiagnosticHoriz( Kgg,inputs,analysis_type,sub_analysis_type);
     280        }
     281        else if (analysis_type==DiagnosticAnalysisEnum()){
     282       
     283                if (sub_analysis_type==HorizAnalysisEnum()){
     284
     285                        CreateKMatrixDiagnosticHoriz( Kgg,inputs,analysis_type,sub_analysis_type);
     286                }
     287                else throw ErrorException(__FUNCT__,exprintf("%s%i%s\n","sub_analysis: ",sub_analysis_type," not supported yet"));
     288
     289        }
     290        else if (analysis_type==SlopeComputeAnalysisEnum()){
     291
     292                CreateKMatrixSlopeCompute( Kgg,inputs,analysis_type,sub_analysis_type);
     293
     294        }
     295        else if (analysis_type==PrognosticAnalysisEnum()){
     296
     297                CreateKMatrixPrognostic( Kgg,inputs,analysis_type,sub_analysis_type);
     298
     299        }
     300        else{
     301                throw ErrorException(__FUNCT__,exprintf("%s%i%s\n","analysis: ",analysis_type," not supported yet"));
     302        }
     303
     304}
     305/*}}}*/
     306/*FUNCTION CreateKMatrixDiagnosticHoriz {{{1*/
     307#undef __FUNCT__
     308#define __FUNCT__ "Tria::CreateKMatrixDiagnosticHoriz"
     309
     310void  Tria::CreateKMatrixDiagnosticHoriz(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
     311
     312
     313        /* local declarations */
     314        int             i,j;
     315
     316        /* node data: */
     317        const int    numgrids=3;
     318        const int    numdof=2*numgrids;
     319        double       xyz_list[numgrids][3];
     320        int          doflist[numdof];
     321        int          numberofdofspernode;
     322
     323        /* gaussian points: */
     324        int     num_gauss,ig;
     325        double* first_gauss_area_coord  =  NULL;
     326        double* second_gauss_area_coord =  NULL;
     327        double* third_gauss_area_coord  =  NULL;
     328        double* gauss_weights           =  NULL;
     329        double  gauss_weight;
     330        double  gauss_l1l2l3[3];
     331
     332        /* material data: */
     333        double viscosity; //viscosity
     334        double newviscosity; //viscosity
     335        double oldviscosity; //viscosity
     336
     337        /* strain rate: */
     338        double epsilon[3]; /* epsilon=[exx,eyy,exy];*/
     339        double oldepsilon[3]; /* oldepsilon=[exx,eyy,exy];*/
     340
     341        /* matrices: */
     342        double B[3][numdof];
     343        double Bprime[3][numdof];
     344        double D[3][3]={{ 0,0,0 },{0,0,0},{0,0,0}};              // material matrix, simple scalar matrix.
     345        double D_scalar;
     346
     347        /* local element matrices: */
     348        double Ke_gg[numdof][numdof]; //local element stiffness matrix
     349        double Ke_gg_gaussian[numdof][numdof]; //stiffness matrix evaluated at the gaussian point.
     350
     351        double Jdet;
     352
     353        /*input parameters for structural analysis (diagnostic): */
     354        double  vxvy_list[numgrids][2]={{0,0},{0,0},{0,0}};
     355        double  oldvxvy_list[numgrids][2]={{0,0},{0,0},{0,0}};
     356        double  thickness;
     357        int     dofs[2]={0,1};
     358
     359        ParameterInputs* inputs=NULL;
     360
     361        /*First, if we are on water, return empty matrix: */
     362        if(onwater)return;
     363
     364        /*recover pointers: */
     365        inputs=(ParameterInputs*)vinputs;
     366
     367        /*recover extra inputs from users, at current convergence iteration: */
     368        inputs->Recover("velocity",&vxvy_list[0][0],2,dofs,numgrids,(void**)nodes);
     369        inputs->Recover("old_velocity",&oldvxvy_list[0][0],2,dofs,numgrids,(void**)nodes);
     370
     371        /* Get node coordinates and dof list: */
     372        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     373        GetDofList(&doflist[0],&numberofdofspernode);
     374
     375        /* Set Ke_gg to 0: */
     376        for(i=0;i<numdof;i++) for(j=0;j<numdof;j++) Ke_gg[i][j]=0.0;
     377
     378#ifdef _DEBUGELEMENTS_
     379        if(my_rank==RANK && id==ELID){
     380                printf("El id %i Rank %i TriaElemnet input list before gaussian loop: \n",ELID,RANK);
     381                printf("   rho_ice: %g \n",matpar->GetRhoIce());
     382                printf("   gravity: %g \n",matpar->GetG())
     383                  printf("   rho_water: %g \n",matpar->GetRhoWater());
     384                printf("   Velocity: \n");
     385                for (i=0;i<numgrids;i++){
     386                        printf("      node %i  [%g,%g]\n",i,vxvy_list[i][0],vxvy_list[i][1]);
     387                }
     388                printf("   flow_law_parameter [%g ]\n",matice->GetB());
     389                printf("   drag [%g %g %g ]\n",k[0],k[1],k[2]);
     390                printf("   thickness [%g %g %g]\n",h[0],h[1],h[2]);
     391                printf("   surface [%g %g %g ]\n",s[0],s[1],s[2]);
     392                printf("   bed [%g %g %g]\n",b[0],b[1],b[2]);
     393        }
     394#endif
     395
     396
     397        /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
     398        GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
     399
     400#ifdef _DEBUGELEMENTS_
     401        if(my_rank==RANK && id==ELID){
     402                printf("   gaussian points: \n");
     403                for(i=0;i<num_gauss;i++){
     404                        printf("    %g %g %g : %g\n",first_gauss_area_coord[i],second_gauss_area_coord[i],third_gauss_area_coord[i],gauss_weights[i]);
     405                }
     406        }
     407#endif
     408
     409        /* Start  looping on the number of gaussian points: */
     410        for (ig=0; ig<num_gauss; ig++){
     411                /*Pick up the gaussian point: */
     412                gauss_weight=*(gauss_weights+ig);
     413                gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
     414                gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
     415                gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
     416
     417
     418                /*Compute thickness at gaussian point: */
     419                GetParameterValue(&thickness, &h[0],gauss_l1l2l3);
     420
     421                /*Get strain rate from velocity: */
     422                GetStrainRate(&epsilon[0],&vxvy_list[0][0],&xyz_list[0][0],gauss_l1l2l3);
     423                GetStrainRate(&oldepsilon[0],&oldvxvy_list[0][0],&xyz_list[0][0],gauss_l1l2l3);
     424
     425                /*Get viscosity: */
     426                matice->GetViscosity2d(&viscosity, &epsilon[0]);
     427                matice->GetViscosity2d(&oldviscosity, &oldepsilon[0]);
     428
     429                /* Get Jacobian determinant: */
     430                GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
     431
     432                /* Build the D matrix: we plug the gaussian weight, the thickness, the viscosity, and the jacobian determinant
     433                        onto this scalar matrix, so that we win some computational time: */
     434                newviscosity=viscosity+numpar->viscosity_overshoot*(viscosity-oldviscosity);
     435                D_scalar=newviscosity*thickness*gauss_weight*Jdet;
     436
     437                for (i=0;i<3;i++){
     438                        D[i][i]=D_scalar;
     439                }
     440
     441#ifdef _DEBUGELEMENTS_
     442                if(my_rank==RANK && id==ELID){
     443                        printf("   gaussian loop %i\n",ig);
     444                        printf("      thickness %g\n",thickness);
     445                        printf("      slope [%g,%g]\n",slope[0],slope[1]);
     446                        printf("      alpha2_list [%g,%g,%g]\n",alpha2_list[0],alpha2_list[1],alpha2_list[2]);
     447                        printf("      epsilon [%g,%g,%g]\n",epsilon[0],epsilon[1],epsilon[2]);
     448                        printf("      Matice: \n");
     449                        matice->Echo();
     450                        printf("      Matpar: \n");
     451                        matpar->Echo();
     452                        printf("\n    viscosity: %g \n",viscosity);
     453                        printf("      jacobian: %g \n",Jdet);
     454                        printf("      gauss_weight: %g \n",gauss_weight);
     455                }
     456#endif
     457
     458                /*Get B and Bprime matrices: */
     459                GetB(&B[0][0], &xyz_list[0][0], gauss_l1l2l3);
     460                GetBPrime(&Bprime[0][0], &xyz_list[0][0], gauss_l1l2l3);
     461
     462                /*  Do the triple product tB*D*Bprime: */
     463                TripleMultiply( &B[0][0],3,numdof,1,
     464                                        &D[0][0],3,3,0,
     465                                        &Bprime[0][0],3,numdof,0,
     466                                        &Ke_gg_gaussian[0][0],0);
     467
     468                /* Add the Ke_gg_gaussian, and optionally Ke_gg_drag_gaussian onto Ke_gg: */
     469                for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_gaussian[i][j];
     470
     471#ifdef _DEBUGELEMENTS_
     472                if(my_rank==RANK && id==ELID){
     473                        printf("      B:\n");
     474                        for(i=0;i<3;i++){
     475                                for(j=0;j<numdof;j++){
     476                                        printf("%g ",B[i][j]);
     477                                }
     478                                printf("\n");
     479                        }
     480                        printf("      Bprime:\n");
     481                        for(i=0;i<3;i++){
     482                                for(j=0;j<numdof;j++){
     483                                        printf("%g ",Bprime[i][j]);
     484                                }
     485                                printf("\n");
     486                        }
     487                }
     488#endif
     489        } // for (ig=0; ig<num_gauss; ig++)
     490
     491        /*Add Ke_gg to global matrix Kgg: */
     492        MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)Ke_gg,ADD_VALUES);
     493
     494
     495        /*Do not forget to include friction: */
     496        if(!shelf){
     497                CreateKMatrixDiagnosticHorizFriction(Kgg,inputs,analysis_type,sub_analysis_type);
     498        }
     499
     500#ifdef _DEBUGELEMENTS_
     501        if(my_rank==RANK && id==ELID){
     502                printf("      Ke_gg erms:\n");
     503                for( i=0; i<numdof; i++){
     504                        for (j=0;j<numdof;j++){
     505                                printf("%g ",Ke_gg[i][j]);
     506                        }
     507                        printf("\n");
     508                }
     509                printf("      Ke_gg row_indices:\n");
     510                for( i=0; i<numdof; i++){
     511                        printf("%i ",doflist[i]);
     512                }
     513
     514        }
     515#endif
     516
     517cleanup_and_return:
     518        xfree((void**)&first_gauss_area_coord);
     519        xfree((void**)&second_gauss_area_coord);
     520        xfree((void**)&third_gauss_area_coord);
     521        xfree((void**)&gauss_weights);
     522
     523}
     524/*}}}*/
     525/*FUNCTION CreateKMatrixDiagnosticHorizFriction {{{1*/
     526#undef __FUNCT__
     527#define __FUNCT__ "Tria::CreateKMatrixDiagnosticHorizFriction"
     528void  Tria::CreateKMatrixDiagnosticHorizFriction(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
     529
     530
     531        /* local declarations */
     532        int             i,j;
     533
     534        /* node data: */
     535        const int    numgrids=3;
     536        const int    numdof=2*numgrids;
     537        double       xyz_list[numgrids][3];
     538        int          doflist[numdof];
     539        int          numberofdofspernode;
     540       
     541        /* gaussian points: */
     542        int     num_gauss,ig;
     543        double* first_gauss_area_coord  =  NULL;
     544        double* second_gauss_area_coord =  NULL;
     545        double* third_gauss_area_coord  =  NULL;
     546        double* gauss_weights           =  NULL;
     547        double  gauss_weight;
     548        double  gauss_l1l2l3[3];
     549
     550        /* matrices: */
     551        double L[2][numdof];
     552        double DL[2][2]={{ 0,0 },{0,0}}; //for basal drag
     553        double DL_scalar;
     554
     555        /* local element matrices: */
     556        double Ke_gg[numdof][numdof]; //local element stiffness matrix
     557        double Ke_gg_gaussian[numdof][numdof]; //stiffness matrix contribution from drag
     558       
     559        double Jdet;
     560       
     561        /*slope: */
     562        double  slope[2]={0.0,0.0};
     563        double  slope_magnitude;
     564
     565        /*input parameters for structural analysis (diagnostic): */
     566        double  vxvy_list[numgrids][2]={{0,0},{0,0},{0,0}};
     567        int     dofs[2]={0,1};
     568
     569        /*friction: */
     570        double alpha2_list[numgrids]={0.0,0.0,0.0};
     571        double alpha2;
     572
     573        double MAXSLOPE=.06; // 6 %
     574        double MOUNTAINKEXPONENT=10;
     575
     576        ParameterInputs* inputs=NULL;
     577
     578        /*recover pointers: */
     579        inputs=(ParameterInputs*)vinputs;
     580       
     581        /* Get node coordinates and dof list: */
     582        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     583        GetDofList(&doflist[0],&numberofdofspernode);
     584
     585        /* Set Ke_gg to 0: */
     586        for(i=0;i<numdof;i++) for(j=0;j<numdof;j++) Ke_gg[i][j]=0.0;
     587
     588        if (shelf){
     589                /*no friction, do nothing*/
     590                return;
     591        }
     592
     593        if (friction_type!=2)throw ErrorException(__FUNCT__," non-viscous friction not supported yet!");
     594
     595        /*recover extra inputs from users, at current convergence iteration: */
     596        inputs->Recover("velocity",&vxvy_list[0][0],2,dofs,numgrids,(void**)nodes);
     597
     598        /*Build alpha2_list used by drag stiffness matrix*/
     599        Friction* friction=NewFriction();
     600       
     601        /*Initialize all fields: */
     602        friction->element_type=(char*)xmalloc((strlen("2d")+1)*sizeof(char));
     603        strcpy(friction->element_type,"2d");
     604       
     605        friction->gravity=matpar->GetG();
     606        friction->rho_ice=matpar->GetRhoIce();
     607        friction->rho_water=matpar->GetRhoWater();
     608        friction->K=&k[0];
     609        friction->bed=&b[0];
     610        friction->thickness=&h[0];
     611        friction->velocities=&vxvy_list[0][0];
     612        friction->p=p;
     613        friction->q=q;
     614
     615        /*Compute alpha2_list: */
     616        FrictionGetAlpha2(&alpha2_list[0],friction);
     617
     618        /*Erase friction object: */
     619        DeleteFriction(&friction);
     620
     621        #ifdef _DEBUGELEMENTS_
     622        if(my_rank==RANK && id==ELID){
     623                printf("   alpha2_list [%g %g %g ]\n",alpha2_list[0],alpha2_list[1],alpha2_list[2]);
     624        }
     625        #endif
     626
     627        /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
     628        GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
     629
     630        #ifdef _DEBUGELEMENTS_
     631        if(my_rank==RANK && id==ELID){
     632                printf("   gaussian points: \n");
     633                for(i=0;i<num_gauss;i++){
     634                        printf("    %g %g %g : %g\n",first_gauss_area_coord[i],second_gauss_area_coord[i],third_gauss_area_coord[i],gauss_weights[i]);
     635                }
     636        }
     637        #endif
     638
     639        /* Start  looping on the number of gaussian points: */
     640        for (ig=0; ig<num_gauss; ig++){
     641                /*Pick up the gaussian point: */
     642                gauss_weight=*(gauss_weights+ig);
     643                gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
     644                gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
     645                gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
     646
     647
     648                // If we have a slope > 6% for this element,  it means  we are on a mountain. In this particular case,
     649                //velocity should be = 0. To achieve this result, we set alpha2_list to a very high value: */
     650                GetParameterDerivativeValue(&slope[0], &s[0],&xyz_list[0][0], gauss_l1l2l3);
     651                slope_magnitude=sqrt(pow(slope[0],2)+pow(slope[1],2));
     652
     653                if (slope_magnitude>MAXSLOPE){
     654                        alpha2_list[0]=pow((double)10,MOUNTAINKEXPONENT);
     655                        alpha2_list[1]=pow((double)10,MOUNTAINKEXPONENT);
     656                        alpha2_list[2]=pow((double)10,MOUNTAINKEXPONENT);
     657                }
     658
     659                /* Get Jacobian determinant: */
     660                GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
     661
     662                /*Get L matrix: */
     663                GetL(&L[0][0], &xyz_list[0][0], gauss_l1l2l3,numberofdofspernode);
     664
     665                /*Now, take care of the basal friction if there is any: */
     666                GetParameterValue(&alpha2, &alpha2_list[0],gauss_l1l2l3);
     667
     668                DL_scalar=alpha2*gauss_weight*Jdet;
     669                for (i=0;i<2;i++){
     670                        DL[i][i]=DL_scalar;
     671                }
     672               
     673                /*  Do the triple producte tL*D*L: */
     674                TripleMultiply( &L[0][0],2,numdof,1,
     675                                        &DL[0][0],2,2,0,
     676                                        &L[0][0],2,numdof,0,
     677                                        &Ke_gg_gaussian[0][0],0);
     678
     679                for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_gaussian[i][j];
     680
     681        } // for (ig=0; ig<num_gauss; ig++)
     682
     683        /*Add Ke_gg to global matrix Kgg: */
     684        MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)Ke_gg,ADD_VALUES);
     685
     686        cleanup_and_return:
     687        xfree((void**)&first_gauss_area_coord);
     688        xfree((void**)&second_gauss_area_coord);
     689        xfree((void**)&third_gauss_area_coord);
     690        xfree((void**)&gauss_weights);
     691
     692}       
     693/*}}}*/
     694/*FUNCTION CreateKMatrixDiagnosticSurfaceVert {{{1*/
     695#undef __FUNCT__
     696#define __FUNCT__ "Tria::CreateKMatrixDiagnosticSurfaceVert"
     697void  Tria::CreateKMatrixDiagnosticSurfaceVert(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
     698
     699        int i,j;
     700
     701        /* node data: */
     702        const int    numgrids=3;
     703        const int    NDOF1=1;
     704        const int    numdof=NDOF1*numgrids;
     705        double       xyz_list[numgrids][3];
     706        int          doflist[numdof];
     707        int          numberofdofspernode;
     708
     709        /* gaussian points: */
     710        int     num_gauss,ig;
     711        double* first_gauss_area_coord  =  NULL;
     712        double* second_gauss_area_coord =  NULL;
     713        double* third_gauss_area_coord  =  NULL;
     714        double* gauss_weights           =  NULL;
     715        double  gauss_weight;
     716        double  gauss_l1l2l3[3];
     717
     718
     719        /* surface normal: */
     720        double x4,y4,z4;
     721        double x5,y5,z5;
     722        double x6,y6,z6;
     723        double v46[3];
     724        double v56[3];
     725        double normal[3];
     726        double norm_normal;
     727        double nz;
     728
     729        /*Matrices: */
     730        double DL_scalar;
     731        double L[3];
     732        double Jdet;
     733
     734        /* local element matrices: */
     735        double Ke_gg[numdof][numdof]; //local element stiffness matrix
     736        double Ke_gg_gaussian[numdof][numdof]; //stiffness matrix evaluated at the gaussian point.
     737
     738        ParameterInputs* inputs=NULL;
     739
     740        /*recover pointers: */
     741        inputs=(ParameterInputs*)vinputs;
     742
     743        /* Get node coordinates and dof list: */
     744        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     745        GetDofList(&doflist[0],&numberofdofspernode);
     746
     747        /* Set Ke_gg to 0: */
     748        for(i=0;i<numdof;i++) for(j=0;j<numdof;j++) Ke_gg[i][j]=0.0;
     749
     750        /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
     751        GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
     752
     753        /*Build normal vector to the surface:*/
     754
     755        x4=xyz_list[0][0];
     756        y4=xyz_list[0][1];
     757        z4=xyz_list[0][2];
     758
     759        x5=xyz_list[1][0];
     760        y5=xyz_list[1][1];
     761        z5=xyz_list[1][2];
     762
     763        x6=xyz_list[2][0];
     764        y6=xyz_list[2][1];
     765        z6=xyz_list[2][2];
     766
     767        v46[0]=x4-x6;
     768        v46[1]=y4-y6;
     769        v46[2]=z4-z6;
     770
     771        v56[0]=x5-x6;
     772        v56[1]=y5-y6;
     773        v56[2]=z5-z6;
     774
     775        normal[0]=(y4-y6)*(z5-z6)-(z4-z6)*(y5-y6);
     776        normal[1]=(z4-z6)*(x5-x6)-(x4-x6)*(z5-z6);
     777        normal[2]=(x4-x6)*(y5-y6)-(y4-y6)*(x5-x6);
     778
     779        norm_normal=sqrt(pow(normal[0],(double)2)+pow(normal[1],(double)2)+pow(normal[2],(double)2));
     780        nz=1.0/norm_normal*normal[2];
     781
     782        /* Start  looping on the number of gaussian points: */
     783        for (ig=0; ig<num_gauss; ig++){
     784                /*Pick up the gaussian point: */
     785                gauss_weight=*(gauss_weights+ig);
     786                gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
     787                gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
     788                gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
     789
     790                /* Get Jacobian determinant: */
     791                GetJacobianDeterminant3d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
     792
     793                //Get L matrix if viscous basal drag present:
     794                GetL(&L[0], &xyz_list[0][0], gauss_l1l2l3,NDOF1);
     795
     796                /**********************Do not forget the sign**********************************/
     797                DL_scalar=- gauss_weight*Jdet*nz;
     798                /******************************************************************************/
     799
     800                /*  Do the triple producte tL*D*L: */
     801                TripleMultiply( L,1,3,1,
     802                                        &DL_scalar,1,1,0,
     803                                        L,1,3,0,
     804                                        &Ke_gg_gaussian[0][0],0);
     805
     806                /* Add the Ke_gg_gaussian, onto Ke_gg: */
     807                for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_gaussian[i][j];
     808
     809
     810        } //for (ig=0; ig<num_gauss; ig++)
     811
     812        /*Add Ke_gg to global matrix Kgg: */
     813        MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)Ke_gg,ADD_VALUES);
     814
     815cleanup_and_return:
     816        xfree((void**)&first_gauss_area_coord);
     817        xfree((void**)&second_gauss_area_coord);
     818        xfree((void**)&third_gauss_area_coord);
     819        xfree((void**)&gauss_weights);
     820}
     821/*}}}*/
     822/*FUNCTION CreateKMatrixMelting {{{1*/
     823#undef __FUNCT__
     824#define __FUNCT__ "Tria::CreateKMatrixMelting"
     825void  Tria::CreateKMatrixMelting(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
     826
     827        /*indexing: */
     828        int i,j;
     829
     830        const int  numgrids=3;
     831        const int  NDOF1=1;
     832        const int  numdof=numgrids*NDOF1;
     833        int        doflist[numdof];
     834        int        numberofdofspernode;
     835
     836        /*Grid data: */
     837        double     xyz_list[numgrids][3];
     838
     839        /*Material constants */
     840        double     heatcapacity,latentheat;
     841
     842        /* gaussian points: */
     843        int     num_area_gauss,ig;
     844        double* gauss_weights  =  NULL;
     845        double* first_gauss_area_coord  =  NULL;
     846        double* second_gauss_area_coord =  NULL;
     847        double* third_gauss_area_coord  =  NULL;
     848        double  gauss_weight;
     849        double  gauss_coord[3];
     850
     851        /*matrices: */
     852        double     Jdet;
     853        double     D_scalar;
     854        double     K_terms[numdof][numdof]={0.0};
     855        double     L[3];
     856        double     tLD[3];
     857        double     Ke_gaussian[numdof][numdof]={0.0};
     858
     859        /*Recover constants of ice */
     860        latentheat=matpar->GetLatentHeat();
     861        heatcapacity=matpar->GetHeatCapacity();
     862
     863        /* Get node coordinates and dof list: */
     864        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     865        GetDofList(&doflist[0],&numberofdofspernode);
     866
     867        /* Get gaussian points and weights: */
     868        GaussTria (&num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
     869
     870        /* Start looping on the number of gauss  (nodes on the bedrock) */
     871        for (ig=0; ig<num_area_gauss; ig++){
     872                gauss_weight=*(gauss_weights+ig);
     873                gauss_coord[0]=*(first_gauss_area_coord+ig);
     874                gauss_coord[1]=*(second_gauss_area_coord+ig);
     875                gauss_coord[2]=*(third_gauss_area_coord+ig);
     876
     877                //Get the Jacobian determinant
     878                GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0], gauss_coord);
     879
     880                /*Get L matrix : */
     881                GetL(&L[0], &xyz_list[0][0], gauss_coord,NDOF1);
     882
     883                /*Calculate DL on gauss point */
     884                D_scalar=latentheat/heatcapacity*gauss_weight*Jdet;
     885
     886                /*  Do the triple product tL*D*L: */
     887                MatrixMultiply(&L[0],numdof,1,0,&D_scalar,1,1,0,&tLD[0],0);
     888                MatrixMultiply(&tLD[0],numdof,1,0,&L[0],1,numdof,0,&Ke_gaussian[0][0],0);
     889
     890                for(i=0;i<numgrids;i++){
     891                        for(j=0;j<numgrids;j++){
     892                                K_terms[i][j]+=Ke_gaussian[i][j];
     893                        }
     894                }
     895        }
     896
     897        /*Add Ke_gg to global matrix Kgg: */
     898        MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)K_terms,ADD_VALUES);
     899
     900cleanup_and_return:
     901        xfree((void**)&first_gauss_area_coord);
     902        xfree((void**)&second_gauss_area_coord);
     903        xfree((void**)&third_gauss_area_coord);
     904        xfree((void**)&gauss_weights);
     905
     906}
     907/*}}}*/
     908/*FUNCTION CreateKMatrixPrognostic {{{1*/
     909#undef __FUNCT__
     910#define __FUNCT__ "Tria::CreateKMatrixPrognostic"
     911void  Tria::CreateKMatrixPrognostic(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
     912
     913
     914        /* local declarations */
     915        int             i,j;
     916
     917        /* node data: */
     918        const int    numgrids=3;
     919        const int    NDOF1=1;
     920        const int    numdof=NDOF1*numgrids;
     921        double       xyz_list[numgrids][3];
     922        int          doflist[numdof];
     923        int          numberofdofspernode;
     924
     925        /* gaussian points: */
     926        int     num_gauss,ig;
     927        double* first_gauss_area_coord  =  NULL;
     928        double* second_gauss_area_coord =  NULL;
     929        double* third_gauss_area_coord  =  NULL;
     930        double* gauss_weights           =  NULL;
     931        double  gauss_weight;
     932        double  gauss_l1l2l3[3];
     933
     934        /* matrices: */
     935        double L[numgrids];
     936        double B[2][numgrids];
     937        double Bprime[2][numgrids];
     938        double DL[2][2]={0.0};
     939        double DLprime[2][2]={0.0};
     940        double DL_scalar;
     941        double Ke_gg[numdof][numdof]={0.0};//local element stiffness matrix
     942        double Ke_gg_gaussian[numdof][numdof]={0.0}; //stiffness matrix evaluated at the gaussian point.
     943        double Ke_gg_thickness1[numdof][numdof]={0.0}; //stiffness matrix evaluated at the gaussian point.
     944        double Ke_gg_thickness2[numdof][numdof]={0.0}; //stiffness matrix evaluated at the gaussian point.
     945
     946        double Jdettria;
     947
     948        /*input parameters for structural analysis (diagnostic): */
     949        double  vxvy_list[numgrids][2]={0.0};
     950        double  vx_list[numgrids]={0.0};
     951        double  vy_list[numgrids]={0.0};
     952        double  dvx[2];
     953        double  dvy[2];
     954        double  vx,vy;
     955        double  dvxdx,dvydy;
     956        double  v_gauss[2]={0.0};
     957        double  K[2][2]={0.0};
     958        double  KDL[2][2]={0.0};
     959        double  dt;
     960        int     dofs[2]={0,1};
     961        int     found=0;
     962
     963        ParameterInputs* inputs=NULL;
     964
     965        /*recover pointers: */
     966        inputs=(ParameterInputs*)vinputs;
     967
     968        /*recover extra inputs from users, at current convergence iteration: */
     969        found=inputs->Recover("velocity_average",&vxvy_list[0][0],2,dofs,numgrids,(void**)nodes);
     970        if(!found)throw ErrorException(__FUNCT__," could not find velocity_average  in inputs!");
     971
     972        for(i=0;i<numgrids;i++){
     973                vx_list[i]=vxvy_list[i][0];
     974                vy_list[i]=vxvy_list[i][1];
     975        }
     976
     977        found=inputs->Recover("dt",&dt);
     978        if(!found)throw ErrorException(__FUNCT__," could not find dt in inputs!");
     979
     980        /* Get node coordinates and dof list: */
     981        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     982        GetDofList(&doflist[0],&numberofdofspernode);
     983
     984        //Create Artificial diffusivity once for all if requested
     985        if(numpar->artdiff){
     986                //Get the Jacobian determinant
     987                gauss_l1l2l3[0]=1.0/3.0; gauss_l1l2l3[1]=1.0/3.0; gauss_l1l2l3[2]=1.0/3.0;
     988                GetJacobianDeterminant2d(&Jdettria, &xyz_list[0][0],gauss_l1l2l3);
     989
     990                //Build K matrix (artificial diffusivity matrix)
     991                v_gauss[0]=1.0/3.0*(vxvy_list[0][0]+vxvy_list[1][0]+vxvy_list[2][0]);
     992                v_gauss[1]=1.0/3.0*(vxvy_list[0][1]+vxvy_list[1][1]+vxvy_list[2][1]);
     993
     994                K[0][0]=pow(Jdettria,(double).5)/2.0*fabs(v_gauss[0]);
     995                K[1][1]=pow(Jdettria,(double).5)/2.0*fabs(v_gauss[1]);
     996        }
     997
     998        /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
     999        GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
     1000
     1001        /* Start  looping on the number of gaussian points: */
     1002        for (ig=0; ig<num_gauss; ig++){
     1003                /*Pick up the gaussian point: */
     1004                gauss_weight=*(gauss_weights+ig);
     1005                gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
     1006                gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
     1007                gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
     1008
     1009                /* Get Jacobian determinant: */
     1010                GetJacobianDeterminant2d(&Jdettria, &xyz_list[0][0],gauss_l1l2l3);
     1011
     1012                /*Get L matrix: */
     1013                GetL(&L[0], &xyz_list[0][0], gauss_l1l2l3,numberofdofspernode);
     1014
     1015                DL_scalar=gauss_weight*Jdettria;
     1016
     1017                /*  Do the triple product tL*D*L: */
     1018                TripleMultiply( &L[0],1,numdof,1,
     1019                                        &DL_scalar,1,1,0,
     1020                                        &L[0],1,numdof,0,
     1021                                        &Ke_gg_gaussian[0][0],0);
     1022
     1023                /*Get B  and B prime matrix: */
     1024                GetB_prog(&B[0][0], &xyz_list[0][0], gauss_l1l2l3);
     1025                GetBPrime_prog(&Bprime[0][0], &xyz_list[0][0], gauss_l1l2l3);
     1026
     1027                //Get vx, vy and their derivatives at gauss point
     1028                GetParameterValue(&vx, &vx_list[0],gauss_l1l2l3);
     1029                GetParameterValue(&vy, &vy_list[0],gauss_l1l2l3);
     1030
     1031                GetParameterDerivativeValue(&dvx[0], &vx_list[0],&xyz_list[0][0], gauss_l1l2l3);
     1032                GetParameterDerivativeValue(&dvy[0], &vy_list[0],&xyz_list[0][0], gauss_l1l2l3);
     1033
     1034                dvxdx=dvx[0];
     1035                dvydy=dvy[1];
     1036
     1037                DL_scalar=dt*gauss_weight*Jdettria;
     1038
     1039                //Create DL and DLprime matrix
     1040                DL[0][0]=DL_scalar*dvxdx;
     1041                DL[1][1]=DL_scalar*dvydy;
     1042
     1043                DLprime[0][0]=DL_scalar*vx;
     1044                DLprime[1][1]=DL_scalar*vy;
     1045
     1046                //Do the triple product tL*D*L.
     1047                //Ke_gg_thickness=B'*DL*B+B'*DLprime*Bprime;
     1048
     1049                TripleMultiply( &B[0][0],2,numdof,1,
     1050                                        &DL[0][0],2,2,0,
     1051                                        &B[0][0],2,numdof,0,
     1052                                        &Ke_gg_thickness1[0][0],0);
     1053
     1054                TripleMultiply( &B[0][0],2,numdof,1,
     1055                                        &DLprime[0][0],2,2,0,
     1056                                        &Bprime[0][0],2,numdof,0,
     1057                                        &Ke_gg_thickness2[0][0],0);
     1058
     1059                /* Add the Ke_gg_gaussian, and optionally Ke_gg_drag_gaussian onto Ke_gg: */
     1060                for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_gaussian[i][j];
     1061                for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_thickness1[i][j];
     1062                for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_thickness2[i][j];
     1063
     1064                if(numpar->artdiff){
     1065
     1066                        /* Compute artificial diffusivity */
     1067                        KDL[0][0]=DL_scalar*K[0][0];
     1068                        KDL[1][1]=DL_scalar*K[1][1];
     1069
     1070                        TripleMultiply( &Bprime[0][0],2,numdof,1,
     1071                                                &KDL[0][0],2,2,0,
     1072                                                &Bprime[0][0],2,numdof,0,
     1073                                                &Ke_gg_gaussian[0][0],0);
     1074
     1075                        /* Add artificial diffusivity matrix */
     1076                        for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_gaussian[i][j];
     1077
     1078                }
     1079
     1080#ifdef _DEBUGELEMENTS_
     1081                if(my_rank==RANK && id==ELID){
     1082                        printf("      B:\n");
     1083                        for(i=0;i<3;i++){
     1084                                for(j=0;j<numdof;j++){
     1085                                        printf("%g ",B[i][j]);
     1086                                }
     1087                                printf("\n");
     1088                        }
     1089                        printf("      Bprime:\n");
     1090                        for(i=0;i<3;i++){
     1091                                for(j=0;j<numdof;j++){
     1092                                        printf("%g ",Bprime[i][j]);
     1093                                }
     1094                                printf("\n");
     1095                        }
     1096                }
     1097#endif
     1098        } // for (ig=0; ig<num_gauss; ig++)
     1099
     1100        /*Add Ke_gg to global matrix Kgg: */
     1101        MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)Ke_gg,ADD_VALUES);
     1102
     1103#ifdef _DEBUGELEMENTS_
     1104        if(my_rank==RANK && id==ELID){
     1105                printf("      Ke_gg erms:\n");
     1106                for( i=0; i<numdof; i++){
     1107                        for (j=0;j<numdof;j++){
     1108                                printf("%g ",Ke_gg[i][j]);
     1109                        }
     1110                        printf("\n");
     1111                }
     1112                printf("      Ke_gg row_indices:\n");
     1113                for( i=0; i<numdof; i++){
     1114                        printf("%i ",doflist[i]);
     1115                }
     1116
     1117        }
     1118#endif
     1119
     1120cleanup_and_return:
     1121        xfree((void**)&first_gauss_area_coord);
     1122        xfree((void**)&second_gauss_area_coord);
     1123        xfree((void**)&third_gauss_area_coord);
     1124        xfree((void**)&gauss_weights);
     1125
     1126}
     1127/*}}}*/
     1128/*FUNCTION CreateKMatrixSlopeCompute {{{1*/
     1129#undef __FUNCT__
     1130#define __FUNCT__ "Tria::CreateKMatrixSlopeCompute"
     1131
     1132void  Tria::CreateKMatrixSlopeCompute(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
     1133
     1134        /* local declarations */
     1135        int             i,j;
     1136
     1137        /* node data: */
     1138        const int    numgrids=3;
     1139        const int    NDOF1=1;
     1140        const int    numdof=NDOF1*numgrids;
     1141        double       xyz_list[numgrids][3];
     1142        int          doflist[numdof];
     1143        int          numberofdofspernode;
     1144       
     1145        /* gaussian points: */
     1146        int     num_gauss,ig;
     1147        double* first_gauss_area_coord  =  NULL;
     1148        double* second_gauss_area_coord =  NULL;
     1149        double* third_gauss_area_coord  =  NULL;
     1150        double* gauss_weights           =  NULL;
     1151        double  gauss_weight;
     1152        double  gauss_l1l2l3[3];
     1153
     1154        /* matrices: */
     1155        double L[1][3];
     1156        double DL_scalar;
     1157
     1158        /* local element matrices: */
     1159        double Ke_gg[numdof][numdof]; //local element stiffness matrix
     1160        double Ke_gg_gaussian[numdof][numdof]; //stiffness matrix evaluated at the gaussian point.
     1161       
     1162        double Jdet;
     1163       
     1164        /* Get node coordinates and dof list: */
     1165        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     1166        GetDofList(&doflist[0],&numberofdofspernode);
     1167
     1168        /* Set Ke_gg to 0: */
     1169        for(i=0;i<numdof;i++) for(j=0;j<numdof;j++) Ke_gg[i][j]=0.0;
     1170
     1171        /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
     1172        GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
     1173
     1174        /* Start  looping on the number of gaussian points: */
     1175        for (ig=0; ig<num_gauss; ig++){
     1176                /*Pick up the gaussian point: */
     1177                gauss_weight=*(gauss_weights+ig);
     1178                gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
     1179                gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
     1180                gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
     1181
     1182               
     1183                /*Get L matrix: */
     1184                GetL(&L[0][0], &xyz_list[0][0], gauss_l1l2l3,NDOF1);
     1185
     1186                /* Get Jacobian determinant: */
     1187                GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
     1188               
     1189                DL_scalar=gauss_weight*Jdet;
     1190
     1191                /*  Do the triple producte tL*D*L: */
     1192                TripleMultiply( &L[0][0],1,3,1,
     1193                                        &DL_scalar,1,1,0,
     1194                                        &L[0][0],1,3,0,
     1195                                        &Ke_gg_gaussian[0][0],0);
     1196
     1197                /* Add the Ke_gg_gaussian, and optionally Ke_gg_drag_gaussian onto Ke_gg: */
     1198                for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_gaussian[i][j];
     1199        } //for (ig=0; ig<num_gauss; ig++
     1200
     1201        /*Add Ke_gg to global matrix Kgg: */
     1202        MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)Ke_gg,ADD_VALUES);
     1203               
     1204        cleanup_and_return:
     1205        xfree((void**)&first_gauss_area_coord);
     1206        xfree((void**)&second_gauss_area_coord);
     1207        xfree((void**)&third_gauss_area_coord);
     1208        xfree((void**)&gauss_weights);
     1209}
     1210/*}}}*/
     1211/*FUNCTION CreateKMatrixThermal {{{1*/
     1212#undef __FUNCT__
     1213#define __FUNCT__ "Tria::CreateKMatrixThermal"
     1214void  Tria::CreateKMatrixThermal(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
     1215
     1216        int i,j;
     1217        int found=0;
     1218       
     1219        /* node data: */
     1220        const int    numgrids=3;
     1221        const int    NDOF1=1;
     1222        const int    numdof=NDOF1*numgrids;
     1223        double       xyz_list[numgrids][3];
     1224        int          doflist[numdof];
     1225        int          numberofdofspernode;
     1226
     1227        double mixed_layer_capacity;
     1228        double thermal_exchange_velocity;
     1229        double rho_water;
     1230        double rho_ice;
     1231        double heatcapacity;
     1232        double dt;
     1233
     1234        int     num_gauss,ig;
     1235        double* first_gauss_area_coord  =  NULL;
     1236        double* second_gauss_area_coord =  NULL;
     1237        double* third_gauss_area_coord  =  NULL;
     1238        double* gauss_weights           =  NULL;
     1239        double  gauss_weight;
     1240        double  gauss_coord[3];
     1241
     1242        /*matrices: */
     1243        double  Jdet;
     1244        double  K_terms[numdof][numdof]={0.0};
     1245        double  Ke_gaussian[numdof][numdof]={0.0};
     1246        double  l1l2l3[numgrids];
     1247        double     tl1l2l3D[3];
     1248        double  D_scalar;
     1249        ParameterInputs* inputs=NULL;
     1250
     1251        /*recover pointers: */
     1252        inputs=(ParameterInputs*)vinputs;
     1253
     1254        /*recover extra inputs from users, dt: */
     1255        found=inputs->Recover("dt",&dt);
     1256        if(!found)throw ErrorException(__FUNCT__," could not find dt in inputs!");
     1257
     1258        /* Get node coordinates and dof list: */
     1259        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     1260        GetDofList(&doflist[0],&numberofdofspernode);
     1261
     1262        //recover material parameters
     1263        mixed_layer_capacity=matpar->GetMixedLayerCapacity();
     1264        thermal_exchange_velocity=matpar->GetThermalExchangeVelocity();
     1265        rho_water=matpar->GetRhoWater();
     1266        rho_ice=matpar->GetRhoIce();
     1267        heatcapacity=matpar->GetHeatCapacity();
     1268
     1269
     1270        GaussTria (&num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
     1271
     1272        /* Start looping on the number of gauss (nodes on the bedrock) */
     1273        for (ig=0; ig<num_gauss; ig++){
     1274                gauss_weight=*(gauss_weights+ig);
     1275                gauss_coord[0]=*(first_gauss_area_coord+ig);
     1276                gauss_coord[1]=*(second_gauss_area_coord+ig);
     1277                gauss_coord[2]=*(third_gauss_area_coord+ig);
     1278               
     1279                //Get the Jacobian determinant
     1280                GetJacobianDeterminant3d(&Jdet, &xyz_list[0][0], gauss_coord);
     1281               
     1282                /*Get nodal functions values: */
     1283                GetNodalFunctions(&l1l2l3[0], gauss_coord);
     1284                               
     1285                /*Calculate DL on gauss point */
     1286                D_scalar=gauss_weight*Jdet*rho_water*mixed_layer_capacity*thermal_exchange_velocity/(heatcapacity*rho_ice);
     1287                if(dt){
     1288                        D_scalar=dt*D_scalar;
     1289                }
     1290
     1291                /*  Do the triple product tL*D*L: */
     1292                MatrixMultiply(&l1l2l3[0],numdof,1,0,&D_scalar,1,1,0,&tl1l2l3D[0],0);
     1293                MatrixMultiply(&tl1l2l3D[0],numdof,1,0,&l1l2l3[0],1,numdof,0,&Ke_gaussian[0][0],0);
     1294
     1295                for(i=0;i<3;i++){
     1296                        for(j=0;j<3;j++){
     1297                                K_terms[i][j]+=Ke_gaussian[i][j];
     1298                        }
     1299                }
     1300        }
     1301       
     1302        /*Add Ke_gg to global matrix Kgg: */
     1303        MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)K_terms,ADD_VALUES);
     1304
     1305        cleanup_and_return:
     1306        xfree((void**)&first_gauss_area_coord);
     1307        xfree((void**)&second_gauss_area_coord);
     1308        xfree((void**)&third_gauss_area_coord);
     1309        xfree((void**)&gauss_weights);
     1310
     1311}
     1312/*}}}*/
     1313/*FUNCTION CreatePVector {{{1*/
     1314#undef __FUNCT__
     1315#define __FUNCT__ "Tria::CreatePVector"
     1316void  Tria::CreatePVector(Vec pg,void* inputs,int analysis_type,int sub_analysis_type){
     1317       
     1318        /*Just branch to the correct load generator, according to the type of analysis we are carrying out: */
     1319        if (analysis_type==ControlAnalysisEnum()){
     1320               
     1321                CreatePVectorDiagnosticHoriz( pg,inputs,analysis_type,sub_analysis_type);
     1322       
     1323        }
     1324        else if (analysis_type==DiagnosticAnalysisEnum()){
     1325                if (sub_analysis_type==HorizAnalysisEnum()){
     1326               
     1327                        CreatePVectorDiagnosticHoriz( pg,inputs,analysis_type,sub_analysis_type);
     1328               
     1329                }
     1330                else throw ErrorException(__FUNCT__,exprintf("%s%i%s\n","sub_analysis: ",sub_analysis_type," not supported yet"));
     1331        }
     1332        else if (analysis_type==SlopeComputeAnalysisEnum()){
     1333               
     1334                CreatePVectorSlopeCompute( pg,inputs,analysis_type,sub_analysis_type);
     1335        }
     1336        else if (analysis_type==PrognosticAnalysisEnum()){
     1337
     1338                CreatePVectorPrognostic( pg,inputs,analysis_type,sub_analysis_type);
     1339        }
     1340        else{
     1341                throw ErrorException(__FUNCT__,exprintf("%s%i%s"," analysis ",analysis_type," not supported yet"));
     1342        }
     1343
     1344}
     1345/*}}}*/
     1346/*FUNCTION CreatePVectorDiagnosticBaseVert {{{1*/
     1347#undef __FUNCT__
     1348#define __FUNCT__ "Tria::CreatePVectorDiagnosticBaseVert"
     1349void  Tria::CreatePVectorDiagnosticBaseVert(Vec pg,void* vinputs,int analysis_type,int sub_analysis_type){
     1350
     1351        int             i,j;
     1352
     1353        /* node data: */
     1354        const int    numgrids=3;
     1355        const int    NDOF1=1;
     1356        const int    numdof=NDOF1*numgrids;
     1357        double       xyz_list[numgrids][3];
     1358        int          doflist[numdof];
     1359        int          numberofdofspernode;
     1360
     1361        /* gaussian points: */
     1362        int     num_gauss,ig;
     1363        double* first_gauss_area_coord  =  NULL;
     1364        double* second_gauss_area_coord =  NULL;
     1365        double* third_gauss_area_coord  =  NULL;
     1366        double* gauss_weights           =  NULL;
     1367        double  gauss_weight;
     1368        double  gauss_l1l2l3[3];
     1369
     1370        /* Jacobian: */
     1371        double Jdet;
     1372
     1373        /*nodal functions: */
     1374        double l1l2l3[3];
     1375
     1376        /*element vector at the gaussian points: */
     1377        double  pe_g[numdof];
     1378        double  pe_g_gaussian[numdof];
     1379
     1380        /* matrices: */
     1381        double L[numgrids];
     1382
     1383        /*input parameters for structural analysis (diagnostic): */
     1384        double* velocity_param=NULL;
     1385        double  vx_list[numgrids]={0,0,0};
     1386        double  vy_list[numgrids]={0,0,0};
     1387        double  vx,vy;
     1388        double  meltingvalue;
     1389        double  slope[2];
     1390        double  dbdx,dbdy;
     1391        int     dofs1[1]={0};
     1392        int     dofs2[1]={1};
     1393
     1394        ParameterInputs* inputs=NULL;
     1395
     1396        /*recover pointers: */
     1397        inputs=(ParameterInputs*)vinputs;
     1398
     1399        /* recover input parameters: */
     1400        if(!inputs->Recover("velocity",&vx_list[0],1,dofs1,numgrids,(void**)nodes))throw ErrorException(__FUNCT__," cannot compute vertical velocity without horizontal velocity");
     1401        inputs->Recover("velocity",&vy_list[0],1,dofs2,numgrids,(void**)nodes);
     1402
     1403        /* Get node coordinates and dof list: */
     1404        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     1405        GetDofList(&doflist[0],&numberofdofspernode);
     1406
     1407        /* Set pe_g to 0: */
     1408        for(i=0;i<numdof;i++) pe_g[i]=0.0;
     1409
     1410        /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
     1411        GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
     1412
     1413        /*For icesheets: */
     1414        /* Start  looping on the number of gaussian points: */
     1415        for (ig=0; ig<num_gauss; ig++){
     1416
     1417                /*Pick up the gaussian point: */
     1418                gauss_weight=*(gauss_weights+ig);
     1419                gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
     1420                gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
     1421                gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
     1422
     1423                /*Get melting at gaussian point: */
     1424                GetParameterValue(&meltingvalue, &melting[0],gauss_l1l2l3);
     1425
     1426                /*Get velocity at gaussian point: */
     1427                GetParameterValue(&vx, &vx_list[0],gauss_l1l2l3);
     1428                GetParameterValue(&vy, &vy_list[0],gauss_l1l2l3);
     1429
     1430                /*Get bed slope: */
     1431                GetParameterDerivativeValue(&slope[0], &b[0],&xyz_list[0][0], gauss_l1l2l3);
     1432                dbdx=slope[0];
     1433                dbdy=slope[1];
     1434
     1435                /* Get Jacobian determinant: */
     1436                GetJacobianDeterminant3d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
     1437
     1438                //Get L matrix if viscous basal drag present:
     1439                GetL(&L[0], &xyz_list[0][0], gauss_l1l2l3,NDOF1);
     1440
     1441
     1442                /*Build gaussian vector: */
     1443                for(i=0;i<numgrids;i++){
     1444                        pe_g_gaussian[i]=-Jdet*gauss_weight*(vx*dbdx+vy*dbdy-meltingvalue)*L[i];
     1445                }
     1446
     1447                /*Add pe_g_gaussian vector to pe_g: */
     1448                for( i=0; i<numdof; i++)pe_g[i]+=pe_g_gaussian[i];
     1449
     1450        }
     1451
     1452        /*Add pe_g to global vector pg: */
     1453        VecSetValues(pg,numdof,doflist,(const double*)pe_g,ADD_VALUES);
     1454
     1455cleanup_and_return:
     1456        xfree((void**)&first_gauss_area_coord);
     1457        xfree((void**)&second_gauss_area_coord);
     1458        xfree((void**)&third_gauss_area_coord);
     1459        xfree((void**)&gauss_weights);
     1460
     1461}
     1462/*}}}*/
     1463/*FUNCTION CreatePVectorDiagnosticHoriz {{{1*/
     1464#undef __FUNCT__
     1465#define __FUNCT__ "Tria::CreatePVectorDiagnosticHoriz"
     1466void Tria::CreatePVectorDiagnosticHoriz( Vec pg, void* vinputs, int analysis_type,int sub_analysis_type){
     1467
     1468        int             i,j;
     1469
     1470        /* node data: */
     1471        const int    numgrids=3;
     1472        const int    numdof=2*numgrids;
     1473        const int    NDOF2=2;
     1474        double       xyz_list[numgrids][3];
     1475        int          doflist[numdof];
     1476        int          numberofdofspernode;
     1477       
     1478        /* parameters: */
     1479        double  plastic_stress;
     1480        double  slope[NDOF2];
     1481        double  driving_stress_baseline;
     1482
     1483        /* gaussian points: */
     1484        int     num_gauss,ig;
     1485        double* first_gauss_area_coord  =  NULL;
     1486        double* second_gauss_area_coord =  NULL;
     1487        double* third_gauss_area_coord  =  NULL;
     1488        double* gauss_weights           =  NULL;
     1489        double  gauss_weight;
     1490        double  gauss_l1l2l3[3];
     1491
     1492        /* Jacobian: */
     1493        double Jdet;
     1494
     1495        /*nodal functions: */
     1496        double l1l2l3[3];
     1497
     1498        /*element vector at the gaussian points: */
     1499        double  pe_g[numdof];
     1500        double  pe_g_gaussian[numdof];
     1501
     1502        /*input parameters for structural analysis (diagnostic): */
     1503        double  thickness;
     1504
     1505        ParameterInputs* inputs=NULL;
     1506
     1507        /*First, if we are on water, return empty vector: */
     1508        if(onwater)return;
     1509
     1510        /*recover pointers: */
     1511        inputs=(ParameterInputs*)vinputs;
     1512
     1513        /* Get node coordinates and dof list: */
     1514        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     1515        GetDofList(&doflist[0],&numberofdofspernode);
     1516
     1517        /* Set pe_g to 0: */
     1518        for(i=0;i<numdof;i++) pe_g[i]=0.0;
     1519
     1520
     1521        #ifdef _DEBUGELEMENTS_
     1522        if(my_rank==RANK && id==ELID){
     1523                printf("gravity %g\n",matpar->GetG());
     1524                printf("rho_ice %g\n",matpar->GetRhoIce());
     1525                printf("thickness [%g,%g,%g]\n",h[0],h[1],h[2]);
     1526                printf("surface[%g,%g,%g]\n",s[0],s[1],s[2]);
     1527                printf("bed[%g,%g,%g]\n",b[0],b[1],b[2]);
     1528                printf("drag [%g,%g,%g]\n",k[0],k[1],k[2]);
     1529        }
     1530        #endif
     1531
     1532
     1533        /* Get gaussian points and weights: */
     1534        GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2); /*We need higher order because our load is order 2*/
     1535
     1536        #ifdef _DEBUGELEMENTS_
     1537        if(my_rank==RANK && id==ELID){
     1538                printf("   gaussian points: \n");
     1539                for(i=0;i<num_gauss;i++){
     1540                        printf("    %g %g %g : %g\n",first_gauss_area_coord[i],second_gauss_area_coord[i],third_gauss_area_coord[i],gauss_weights[i]);
     1541                }
     1542        }
     1543        #endif
     1544
     1545
     1546
     1547        /* Start  looping on the number of gaussian points: */
     1548        for (ig=0; ig<num_gauss; ig++){
     1549                /*Pick up the gaussian point: */
     1550                gauss_weight=*(gauss_weights+ig);
     1551                gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
     1552                gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
     1553                gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
     1554
     1555                /*Compute thickness at gaussian point: */
     1556                GetParameterValue(&thickness, &h[0],gauss_l1l2l3);
     1557       
     1558                GetParameterDerivativeValue(&slope[0], &s[0],&xyz_list[0][0], gauss_l1l2l3);
     1559               
     1560                /*In case we have plastic basal drag, compute plastic stress at gaussian point from k1, k2 and k3 fields in the
     1561                 * element itself: */
     1562                if(friction_type==1){
     1563                        GetParameterValue(&plastic_stress, &k[0],gauss_l1l2l3);
     1564                }
     1565
     1566                /* Get Jacobian determinant: */
     1567                GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
     1568               
     1569                 /*Get nodal functions: */
     1570                GetNodalFunctions(l1l2l3, gauss_l1l2l3);
     1571
     1572                /*Compute driving stress: */
     1573                driving_stress_baseline=matpar->GetRhoIce()*matpar->GetG()*thickness;
     1574
     1575
     1576                #ifdef _DEBUGELEMENTS_
     1577                if(my_rank==RANK && id==ELID){
     1578                        printf("      gaussian %i\n",ig);
     1579                        printf("      thickness %g\n",thickness);
     1580                        printf("      slope(%g,%g)\n",slope[0],slope[1]);
     1581                        printf("      Jdet %g\n",Jdet);
     1582                        printf("      gaussweigth %g\n",gauss_weight);
     1583                        printf("      l1l2l3 (%g,%g,%g)\n",l1l2l3[0],l1l2l3[1],l1l2l3[2]);
     1584                        if(friction_type==1)printf("      plastic_stress(%g)\n",plastic_stress);
     1585                }
     1586                #endif
     1587
     1588                /*Build pe_g_gaussian vector: */
     1589                if(friction_type==1){
     1590                        for (i=0;i<numgrids;i++){
     1591                                for (j=0;j<NDOF2;j++){
     1592                                        pe_g_gaussian[i*NDOF2+j]=(-driving_stress_baseline*slope[j]-plastic_stress)*Jdet*gauss_weight*l1l2l3[i];
     1593                                }
     1594                        }
     1595                }
     1596                else {
     1597                        for (i=0;i<numgrids;i++){
     1598                                for (j=0;j<NDOF2;j++){
     1599                                        pe_g_gaussian[i*NDOF2+j]=-driving_stress_baseline*slope[j]*Jdet*gauss_weight*l1l2l3[i];
     1600                                }
     1601                        }
     1602                }
     1603
     1604                /*Add pe_g_gaussian vector to pe_g: */
     1605                for( i=0; i<numdof; i++)pe_g[i]+=pe_g_gaussian[i];
     1606
     1607        } //for (ig=0; ig<num_gauss; ig++)
     1608
     1609        #ifdef _DEBUGELEMENTS_
     1610        if(my_rank==RANK && id==ELID){
     1611                printf("      pe_g->terms\n",ig);
     1612                for( i=0; i<pe_g->nrows; i++){
     1613                        printf("%g ",*(pe_g->terms+i));
     1614                }
     1615                printf("\n");
     1616                printf("      pe_g->row_indices\n",ig);
     1617                for( i=0; i<pe_g->nrows; i++){
     1618                        printf("%i ",*(pe_g->row_indices+i));
     1619                }
     1620        }
     1621        #endif
     1622
     1623        /*Add pe_g to global vector pg: */
     1624        VecSetValues(pg,numdof,doflist,(const double*)pe_g,ADD_VALUES);
     1625
     1626        cleanup_and_return:
     1627        xfree((void**)&first_gauss_area_coord);
     1628        xfree((void**)&second_gauss_area_coord);
     1629        xfree((void**)&third_gauss_area_coord);
     1630        xfree((void**)&gauss_weights);
     1631
     1632}
     1633/*}}}*/
     1634/*FUNCTION CreatePVectorPrognostic {{{1*/
     1635#undef __FUNCT__
     1636#define __FUNCT__ "Tria::CreatePVectorPrognostic"
     1637void  Tria::CreatePVectorPrognostic(Vec pg ,void* vinputs,int analysis_type,int sub_analysis_type){
     1638
     1639
     1640        /* local declarations */
     1641        int             i,j;
     1642
     1643        /* node data: */
     1644        const int    numgrids=3;
     1645        const int    NDOF1=1;
     1646        const int    numdof=NDOF1*numgrids;
     1647        double       xyz_list[numgrids][3];
     1648        int          doflist[numdof];
     1649        int          numberofdofspernode;
     1650
     1651        /* gaussian points: */
     1652        int     num_gauss,ig;
     1653        double* first_gauss_area_coord  =  NULL;
     1654        double* second_gauss_area_coord =  NULL;
     1655        double* third_gauss_area_coord  =  NULL;
     1656        double* gauss_weights           =  NULL;
     1657        double  gauss_weight;
     1658        double  gauss_l1l2l3[3];
     1659
     1660        /* matrix */
     1661        double pe_g[numgrids]={0.0};
     1662        double L[numgrids];
     1663        double Jdettria;
     1664
     1665        /*input parameters for structural analysis (diagnostic): */
     1666        double  accumulation_list[numgrids]={0.0};
     1667        double  accumulation_g;
     1668        double  melting_list[numgrids]={0.0};
     1669        double  melting_g;
     1670        double  thickness_list[numgrids]={0.0};
     1671        double  thickness_g;
     1672        double  dt;
     1673        int     dofs[1]={0};
     1674        int     found=0;
     1675
     1676        ParameterInputs* inputs=NULL;
     1677
     1678        /*recover pointers: */
     1679        inputs=(ParameterInputs*)vinputs;
     1680
     1681        /*recover extra inputs from users, at current convergence iteration: */
     1682        found=inputs->Recover("accumulation",&accumulation_list[0],1,dofs,numgrids,(void**)nodes);
     1683        if(!found)throw ErrorException(__FUNCT__," could not find accumulation in inputs!");
     1684        found=inputs->Recover("melting",&melting_list[0],1,dofs,numgrids,(void**)nodes);
     1685        if(!found)throw ErrorException(__FUNCT__," could not find melting in inputs!");
     1686        found=inputs->Recover("thickness",&thickness_list[0],1,dofs,numgrids,(void**)nodes);
     1687        if(!found)throw ErrorException(__FUNCT__," could not find thickness in inputs!");
     1688        found=inputs->Recover("dt",&dt);
     1689        if(!found)throw ErrorException(__FUNCT__," could not find dt in inputs!");
     1690
     1691        /* Get node coordinates and dof list: */
     1692        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     1693        GetDofList(&doflist[0],&numberofdofspernode);
     1694
     1695        /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
     1696        GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
     1697
     1698        /* Start  looping on the number of gaussian points: */
     1699        for (ig=0; ig<num_gauss; ig++){
     1700                /*Pick up the gaussian point: */
     1701                gauss_weight=*(gauss_weights+ig);
     1702                gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
     1703                gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
     1704                gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
     1705
     1706                /* Get Jacobian determinant: */
     1707                GetJacobianDeterminant2d(&Jdettria, &xyz_list[0][0],gauss_l1l2l3);
     1708
     1709                /*Get L matrix: */
     1710                GetL(&L[0], &xyz_list[0][0], gauss_l1l2l3,numberofdofspernode);
     1711
     1712                /* Get accumulation, melting and thickness at gauss point */
     1713                GetParameterValue(&accumulation_g, &accumulation_list[0],gauss_l1l2l3);
     1714                GetParameterValue(&melting_g, &melting_list[0],gauss_l1l2l3);
     1715                GetParameterValue(&thickness_g, &thickness_list[0],gauss_l1l2l3);
     1716
     1717                /* Add value into pe_g: */
     1718                for( i=0; i<numdof; i++) pe_g[i]+=Jdettria*gauss_weight*(thickness_g+dt*(accumulation_g-melting_g))*L[i];
     1719
     1720        } // for (ig=0; ig<num_gauss; ig++)
     1721
     1722        /*Add pe_g to global matrix Kgg: */
     1723        VecSetValues(pg,numdof,doflist,(const double*)pe_g,ADD_VALUES);
     1724
     1725cleanup_and_return:
     1726        xfree((void**)&first_gauss_area_coord);
     1727        xfree((void**)&second_gauss_area_coord);
     1728        xfree((void**)&third_gauss_area_coord);
     1729        xfree((void**)&gauss_weights);
     1730
     1731}
     1732/*}}}*/
     1733/*FUNCTION CreatePVectorSlopeCompute {{{1*/
     1734#undef __FUNCT__
     1735#define __FUNCT__ "Tria::CreatePVectorSlopeCompute"
     1736
     1737void Tria::CreatePVectorSlopeCompute( Vec pg, void* vinputs, int analysis_type,int sub_analysis_type){
     1738
     1739        int             i,j;
     1740
     1741        /* node data: */
     1742        const int    numgrids=3;
     1743        const int    NDOF1=1;
     1744        const int    numdof=NDOF1*numgrids;
     1745        double       xyz_list[numgrids][3];
     1746        int          doflist[numdof];
     1747        int          numberofdofspernode;
     1748       
     1749        /* gaussian points: */
     1750        int     num_gauss,ig;
     1751        double* first_gauss_area_coord  =  NULL;
     1752        double* second_gauss_area_coord =  NULL;
     1753        double* third_gauss_area_coord  =  NULL;
     1754        double* gauss_weights           =  NULL;
     1755        double  gauss_weight;
     1756        double  gauss_l1l2l3[3];
     1757
     1758        /* Jacobian: */
     1759        double Jdet;
     1760
     1761        /*nodal functions: */
     1762        double l1l2l3[3];
     1763
     1764        /*element vector at the gaussian points: */
     1765        double  pe_g[numdof];
     1766        double  pe_g_gaussian[numdof];
     1767        double  param[3];
     1768        double  slope[2];
     1769
     1770        /* Get node coordinates and dof list: */
     1771        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     1772        GetDofList(&doflist[0],&numberofdofspernode);
     1773
     1774        /* Set pe_g to 0: */
     1775        for(i=0;i<numdof;i++) pe_g[i]=0.0;
     1776
     1777        if ( (sub_analysis_type==SurfaceXAnalysisEnum()) || (sub_analysis_type==SurfaceYAnalysisEnum())){
     1778                for(i=0;i<numdof;i++) param[i]=s[i];
     1779        }
     1780        if ( (sub_analysis_type==BedXAnalysisEnum()) || (sub_analysis_type==BedYAnalysisEnum())){
     1781                for(i=0;i<numdof;i++) param[i]=b[i];
     1782        }
     1783
     1784        /* Get gaussian points and weights: */
     1785        GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2); /*We need higher order because our load is order 2*/
     1786
     1787
     1788        /* Start  looping on the number of gaussian points: */
     1789        for (ig=0; ig<num_gauss; ig++){
     1790                /*Pick up the gaussian point: */
     1791                gauss_weight=*(gauss_weights+ig);
     1792                gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
     1793                gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
     1794                gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
     1795
     1796                GetParameterDerivativeValue(&slope[0], &param[0],&xyz_list[0][0], gauss_l1l2l3);
     1797               
     1798                /* Get Jacobian determinant: */
     1799                GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
     1800               
     1801                 /*Get nodal functions: */
     1802                GetNodalFunctions(l1l2l3, gauss_l1l2l3);
     1803
     1804                /*Build pe_g_gaussian vector: */
     1805                if ( (sub_analysis_type==SurfaceXAnalysisEnum()) || (sub_analysis_type==BedXAnalysisEnum())){
     1806                        for(i=0;i<numdof;i++) pe_g_gaussian[i]=Jdet*gauss_weight*slope[0]*l1l2l3[i];
     1807                }
     1808                if ( (sub_analysis_type==SurfaceYAnalysisEnum()) || (sub_analysis_type==BedYAnalysisEnum())){
     1809                        for(i=0;i<numdof;i++) pe_g_gaussian[i]=Jdet*gauss_weight*slope[1]*l1l2l3[i];
     1810                }
     1811
     1812                /*Add pe_g_gaussian vector to pe_g: */
     1813                for( i=0; i<numdof; i++)pe_g[i]+=pe_g_gaussian[i];
     1814
     1815        } //for (ig=0; ig<num_gauss; ig++)
     1816
     1817        /*Add pe_g to global vector pg: */
     1818        VecSetValues(pg,numdof,doflist,(const double*)pe_g,ADD_VALUES);
     1819
     1820        cleanup_and_return:
     1821        xfree((void**)&first_gauss_area_coord);
     1822        xfree((void**)&second_gauss_area_coord);
     1823        xfree((void**)&third_gauss_area_coord);
     1824        xfree((void**)&gauss_weights);
     1825
     1826}
     1827/*}}}*/
     1828/*FUNCTION CreatePVectorThermalShelf {{{1*/
     1829#undef __FUNCT__
     1830#define __FUNCT__ "Tria::CreatePVectorThermalShelf"
     1831void Tria::CreatePVectorThermalShelf( Vec pg, void* vinputs, int analysis_type,int sub_analysis_type){
     1832
     1833        int i,found;
     1834       
     1835        const int  numgrids=3;
     1836        const int  NDOF1=1;
     1837        const int  numdof=numgrids*NDOF1;
     1838        int        doflist[numdof];
     1839        int        numberofdofspernode;
     1840        double       xyz_list[numgrids][3];
     1841
     1842        double mixed_layer_capacity;
     1843        double thermal_exchange_velocity;
     1844        double rho_water;
     1845        double rho_ice;
     1846        double heatcapacity;
     1847        double beta;
     1848        double meltingpoint;
     1849
     1850        /*inputs: */
     1851        double dt;
     1852        double pressure_list[3];
     1853        double pressure;
     1854
     1855        /* gaussian points: */
     1856        int     num_area_gauss,ig;
     1857        double* gauss_weights  =  NULL;
     1858        double* first_gauss_area_coord  =  NULL;
     1859        double* second_gauss_area_coord =  NULL;
     1860        double* third_gauss_area_coord  =  NULL;
     1861        double  gauss_weight;
     1862        double  gauss_coord[3];
     1863        int     dofs1[1]={0};
     1864
     1865        /*matrices: */
     1866        double  Jdet;
     1867        double  P_terms[numdof]={0.0};
     1868        double  l1l2l3[numgrids];
     1869
     1870        double  t_pmp;
     1871        double  scalar_ocean;
     1872
     1873        ParameterInputs* inputs=NULL;
     1874
     1875        /*recover pointers: */
     1876        inputs=(ParameterInputs*)vinputs;
     1877       
     1878        /* Get node coordinates and dof list: */
     1879        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     1880        GetDofList(&doflist[0],&numberofdofspernode);
     1881
     1882        //recover material parameters
     1883        mixed_layer_capacity=matpar->GetMixedLayerCapacity();
     1884        thermal_exchange_velocity=matpar->GetThermalExchangeVelocity();
     1885        rho_water=matpar->GetRhoWater();
     1886        rho_ice=matpar->GetRhoIce();
     1887        heatcapacity=matpar->GetHeatCapacity();
     1888        beta=matpar->GetBeta();
     1889        meltingpoint=matpar->GetMeltingPoint();
     1890
     1891
     1892        /*recover extra inputs from users, dt and velocity: */
     1893        found=inputs->Recover("dt",&dt);
     1894        if(!found)throw ErrorException(__FUNCT__," could not find dt in inputs!");
     1895        found=inputs->Recover("pressure",&pressure_list[0],1,dofs1,numgrids,(void**)nodes);
     1896        if(!found)throw ErrorException(__FUNCT__," could not find pressure in inputs!");
     1897
     1898        /* Ice/ocean heat exchange flux on ice shelf base */
     1899
     1900        GaussTria (&num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
     1901
     1902        /* Start looping on the number of gauss 2d (nodes on the bedrock) */
     1903        for (ig=0; ig<num_area_gauss; ig++){
     1904                gauss_weight=*(gauss_weights+ig);
     1905                gauss_coord[0]=*(first_gauss_area_coord+ig);
     1906                gauss_coord[1]=*(second_gauss_area_coord+ig);
     1907                gauss_coord[2]=*(third_gauss_area_coord+ig);
     1908
     1909                //Get the Jacobian determinant
     1910                GetJacobianDeterminant3d(&Jdet, &xyz_list[0][0], gauss_coord);
     1911
     1912                /*Get nodal functions values: */
     1913                GetNodalFunctions(&l1l2l3[0], gauss_coord);
     1914
     1915                /*Get geothermal flux and basal friction */
     1916                GetParameterValue(&pressure,&pressure_list[0],gauss_coord);
     1917                t_pmp=meltingpoint-beta*pressure;
     1918
     1919                /*Calculate scalar parameter*/
     1920                scalar_ocean=gauss_weight*Jdet*rho_water*mixed_layer_capacity*thermal_exchange_velocity*(t_pmp)/(heatcapacity*rho_ice);
     1921                if(dt){
     1922                        scalar_ocean=dt*scalar_ocean;
     1923                }
     1924
     1925                for(i=0;i<3;i++){
     1926                        P_terms[i]+=scalar_ocean*l1l2l3[i];
     1927                }
     1928        }
     1929
     1930        /*Add pe_g to global vector pg: */
     1931        VecSetValues(pg,numdof,doflist,(const double*)P_terms,ADD_VALUES);
     1932
     1933        cleanup_and_return:
     1934        xfree((void**)&first_gauss_area_coord);
     1935        xfree((void**)&second_gauss_area_coord);
     1936        xfree((void**)&third_gauss_area_coord);
     1937        xfree((void**)&gauss_weights);
     1938
     1939}
     1940/*}}}*/
     1941/*FUNCTION CreatePVectorThermalSheet {{{1*/
     1942#undef __FUNCT__
     1943#define __FUNCT__ "Tria::CreatePVectorThermalSheet"
     1944void Tria::CreatePVectorThermalSheet( Vec pg, void* vinputs, int analysis_type,int sub_analysis_type){
     1945
     1946        int i,found;
     1947       
     1948        const int  numgrids=3;
     1949        const int  NDOF1=1;
     1950        const int  numdof=numgrids*NDOF1;
     1951        int        doflist[numdof];
     1952        int        numberofdofspernode;
     1953        double       xyz_list[numgrids][3];
     1954        double     vxvyvz_list[numgrids][3];
     1955        double     vx_list[numgrids];
     1956        double     vy_list[numgrids];
     1957
     1958        double rho_ice;
     1959        double heatcapacity;
     1960
     1961        /*inputs: */
     1962        double dt;
     1963        double pressure_list[3];
     1964        double pressure;
     1965        double alpha2_list[3];
     1966        double basalfriction_list[3];
     1967        double basalfriction;
     1968        double geothermalflux_value;
     1969
     1970        /* gaussian points: */
     1971        int     num_area_gauss,ig;
     1972        double* gauss_weights  =  NULL;
     1973        double* first_gauss_area_coord  =  NULL;
     1974        double* second_gauss_area_coord =  NULL;
     1975        double* third_gauss_area_coord  =  NULL;
     1976        double  gauss_weight;
     1977        double  gauss_coord[3];
     1978        int     dofs1[1]={0};
     1979
     1980        /*matrices: */
     1981        double  Jdet;
     1982        double  P_terms[numdof]={0.0};
     1983        double  l1l2l3[numgrids];
     1984        double  scalar;
     1985
     1986        int     dofs[3]={0,1,2};
     1987
     1988        ParameterInputs* inputs=NULL;
     1989
     1990        /*recover pointers: */
     1991        inputs=(ParameterInputs*)vinputs;
     1992       
     1993        /* Get node coordinates and dof list: */
     1994        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     1995        GetDofList(&doflist[0],&numberofdofspernode);
     1996
     1997        //recover material parameters
     1998        rho_ice=matpar->GetRhoIce();
     1999        heatcapacity=matpar->GetHeatCapacity();
     2000
     2001
     2002        /*recover extra inputs from users, dt and velocity: */
     2003        found=inputs->Recover("dt",&dt);
     2004        if(!found)throw ErrorException(__FUNCT__," could not find dt in inputs!");
     2005       
     2006        found=inputs->Recover("velocity",&vxvyvz_list[0][0],3,dofs,numgrids,(void**)nodes);
     2007        if(!found)throw ErrorException(__FUNCT__," could not find velocity in inputs!");
     2008
     2009        for(i=0;i<numgrids;i++){
     2010                vx_list[i]=vxvyvz_list[i][0];
     2011                vy_list[i]=vxvyvz_list[i][1];
     2012        }       
     2013
     2014        /*Build alpha2_list used by drag stiffness matrix*/
     2015        Friction* friction=NewFriction();
     2016       
     2017        /*Initialize all fields: */
     2018        if (friction_type!=2)throw ErrorException(__FUNCT__," non-viscous friction not supported yet!");
     2019       
     2020        friction->element_type=(char*)xmalloc((strlen("3d")+1)*sizeof(char));
     2021        strcpy(friction->element_type,"3d");
     2022       
     2023        friction->gravity=matpar->GetG();
     2024        friction->rho_ice=matpar->GetRhoIce();
     2025        friction->rho_water=matpar->GetRhoWater();
     2026        friction->K=&k[0];
     2027        friction->bed=&b[0];
     2028        friction->thickness=&h[0];
     2029        friction->velocities=&vxvyvz_list[0][0];
     2030        friction->p=p;
     2031        friction->q=q;
     2032
     2033        /*Compute alpha2_list: */
     2034        FrictionGetAlpha2(&alpha2_list[0],friction);
     2035
     2036        /*Erase friction object: */
     2037        DeleteFriction(&friction);
     2038
     2039        /* Compute basal friction */
     2040        for(i=0;i<numgrids;i++){
     2041                basalfriction_list[i]= alpha2_list[i]*(pow(vx_list[i],(double)2.0)+pow(vy_list[i],(double)2.0));
     2042        }
     2043       
     2044        /* Ice/ocean heat exchange flux on ice shelf base */
     2045        GaussTria (&num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
     2046
     2047        /* Start looping on the number of gauss 2d (nodes on the bedrock) */
     2048        for (ig=0; ig<num_area_gauss; ig++){
     2049                gauss_weight=*(gauss_weights+ig);
     2050                gauss_coord[0]=*(first_gauss_area_coord+ig);
     2051                gauss_coord[1]=*(second_gauss_area_coord+ig);
     2052                gauss_coord[2]=*(third_gauss_area_coord+ig);
     2053
     2054                //Get the Jacobian determinant
     2055                GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0], gauss_coord);
     2056
     2057                /*Get nodal functions values: */
     2058                GetNodalFunctions(&l1l2l3[0], gauss_coord);
     2059
     2060                /*Get geothermal flux and basal friction */
     2061                GetParameterValue(&geothermalflux_value,&geothermalflux[0],gauss_coord);
     2062                GetParameterValue(&basalfriction,&basalfriction_list[0],gauss_coord);
     2063
     2064                /*Calculate scalar parameter*/
     2065                scalar=gauss_weight*Jdet*(basalfriction+geothermalflux_value)/(heatcapacity*rho_ice);
     2066                if(dt){
     2067                        scalar=dt*scalar;
     2068                }
     2069
     2070                for(i=0;i<3;i++){
     2071                        P_terms[i]+=scalar*l1l2l3[i];
     2072                }
     2073        }
     2074
     2075        /*Add pe_g to global vector pg: */
     2076        VecSetValues(pg,numdof,doflist,(const double*)P_terms,ADD_VALUES);
     2077
     2078        cleanup_and_return:
     2079        xfree((void**)&first_gauss_area_coord);
     2080        xfree((void**)&second_gauss_area_coord);
     2081        xfree((void**)&third_gauss_area_coord);
     2082        xfree((void**)&gauss_weights);
     2083
     2084}
     2085/*}}}*/
     2086/*FUNCTION DeepEcho{{{1*/
    752087#undef __FUNCT__
    76 #define __FUNCT__ "Tria::Echo"
    77 
    78 void Tria::Echo(void){
     2088#define __FUNCT__ "Tria::DeepEcho"
     2089
     2090void Tria::DeepEcho(void){
    792091
    802092        printf("Tria:\n");
    … …  
    1092121}
    1102122/*}}}*/
    111 /*FUNCTION DeepEcho{{{1*/
     2123/*FUNCTION Du {{{1*/
     2124#undef __FUNCT__
     2125#define __FUNCT__ "Tria::Du"
     2126void Tria::Du(Vec du_g,void* vinputs,int analysis_type,int sub_analysis_type){
     2127
     2128        int i;
     2129
     2130        /* node data: */
     2131        const int    numgrids=3;
     2132        const int    numdof=2*numgrids;
     2133        const int    NDOF2=2;
     2134        double       xyz_list[numgrids][3];
     2135        int          doflist[numdof];
     2136        int          numberofdofspernode;
     2137        int          dofs2[2]={0,1};
     2138
     2139        /* grid data: */
     2140        double vxvy_list[numgrids][2];
     2141        double vx_list[numgrids];
     2142        double vy_list[numgrids];
     2143        double obs_vxvy_list[numgrids][2];
     2144        double obs_vx_list[numgrids];
     2145        double obs_vy_list[numgrids];
     2146        double absolutex_list[numgrids];
     2147        double absolutey_list[numgrids];
     2148        double relativex_list[numgrids];
     2149        double relativey_list[numgrids];
     2150        double logarithmicx_list[numgrids];
     2151        double logarithmicy_list[numgrids];
     2152
     2153        /* gaussian points: */
     2154        int     num_gauss,ig;
     2155        double* first_gauss_area_coord  =  NULL;
     2156        double* second_gauss_area_coord =  NULL;
     2157        double* third_gauss_area_coord  =  NULL;
     2158        double* gauss_weights           =  NULL;
     2159        double  gauss_weight;
     2160        double  gauss_l1l2l3[3];
     2161
     2162        /* parameters: */
     2163        double  obs_velocity_mag,velocity_mag;
     2164        double  absolutex,absolutey,relativex,relativey,logarithmicx,logarithmicy;
     2165
     2166        /*element vector : */
     2167        double  due_g[numdof];
     2168        double  due_g_gaussian[numdof];
     2169
     2170        /* Jacobian: */
     2171        double Jdet;
     2172
     2173        /*nodal functions: */
     2174        double l1l2l3[3];
     2175
     2176        /*relative and algorithmic fitting: */
     2177        double scalex=0;
     2178        double scaley=0;
     2179        double scale=0;
     2180        double  fit=-1;
     2181
     2182        ParameterInputs* inputs=NULL;
     2183
     2184        /*recover pointers: */
     2185        inputs=(ParameterInputs*)vinputs;
     2186
     2187        /* Get node coordinates and dof list: */
     2188        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     2189        GetDofList(&doflist[0],&numberofdofspernode);
     2190
     2191        /* Set due_g to 0: */
     2192        for(i=0;i<numdof;i++) due_g[i]=0.0;
     2193
     2194        /* Recover input data: */
     2195        if(!inputs->Recover("fit",&fit)) throw ErrorException(__FUNCT__," missing fit input parameter");
     2196        if(!inputs->Recover("velocity_obs",&obs_vxvy_list[0][0],2,dofs2,numgrids,(void**)nodes)){
     2197                throw ErrorException(__FUNCT__,"missing velocity_obs input parameter");
     2198        }
     2199        if(!inputs->Recover("velocity",&vxvy_list[0][0],2,dofs2,numgrids,(void**)nodes)){
     2200                throw ErrorException(__FUNCT__,"missing velocity input parameter");
     2201        }
     2202
     2203        for(i=0;i<numgrids;i++){
     2204                obs_vx_list[i]=obs_vxvy_list[i][0];
     2205                obs_vy_list[i]=obs_vxvy_list[i][1];
     2206                vx_list[i]=vxvy_list[i][0];
     2207                vy_list[i]=vxvy_list[i][1];
     2208        }
     2209
     2210        /*Get Du at the 3 nodes (integration of the linearized function)*/
     2211        if(fit==0){
     2212                /*We are using an absolute misfit: */
     2213                for (i=0;i<numgrids;i++){
     2214                        absolutex_list[i]=obs_vx_list[i]-vx_list[i];
     2215                        absolutey_list[i]=obs_vy_list[i]-vy_list[i];
     2216                }
     2217        }
     2218        else if(fit==1){
     2219                /*We are using a relative misfit: */
     2220                for (i=0;i<numgrids;i++){
     2221                        scalex=pow(numpar->meanvel/(obs_vx_list[i]+numpar->epsvel),2);
     2222                        scaley=pow(numpar->meanvel/(obs_vy_list[i]+numpar->epsvel),2);
     2223                        if(obs_vx_list[i]==0)scalex=0;
     2224                        if(obs_vy_list[i]==0)scaley=0;
     2225                        relativex_list[i]=scalex*(obs_vx_list[i]-vx_list[i]);
     2226                        relativey_list[i]=scaley*(obs_vy_list[i]-vy_list[i]);
     2227                }
     2228        }
     2229        else if(fit==2){
     2230                /*We are using a logarithmic misfit: */
     2231                for (i=0;i<numgrids;i++){
     2232                        velocity_mag=sqrt(pow(vx_list[i],2)+pow(vy_list[i],2))+numpar->epsvel; //epsvel to avoid velocity being nil.
     2233                        obs_velocity_mag=sqrt(pow(obs_vx_list[i],2)+pow(obs_vy_list[i],2))+numpar->epsvel; //epsvel to avoid observed velocity being nil.
     2234                        scale=-8*pow(numpar->meanvel,2)/pow(velocity_mag,2)*log(velocity_mag/obs_velocity_mag);
     2235                        logarithmicx_list[i]=scale*vx_list[i];
     2236                        logarithmicy_list[i]=scale*vy_list[i];
     2237                }
     2238        }
     2239        else{
     2240                /*Not supported yet! : */
     2241                throw ErrorException(__FUNCT__,exprintf("%s%g","unsupported type of fit: ",fit));
     2242        }
     2243
     2244        /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
     2245        GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
     2246
     2247#ifdef _DEBUGELEMENTS_
     2248        if(my_rank==RANK && id==ELID){
     2249                printf("   gaussian points: \n");
     2250                for(i=0;i<num_gauss;i++){
     2251                        printf("    %g %g %g : %g\n",first_gauss_area_coord[i],second_gauss_area_coord[i],third_gauss_area_coord[i],gauss_weights[i]);
     2252                }
     2253        }
     2254#endif
     2255
     2256        /* Start  looping on the number of gaussian points: */
     2257        for (ig=0; ig<num_gauss; ig++){
     2258                /*Pick up the gaussian point: */
     2259                gauss_weight=*(gauss_weights+ig);
     2260                gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
     2261                gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
     2262                gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
     2263
     2264                /* Get Jacobian determinant: */
     2265                GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
     2266#ifdef _ISSM_DEBUG_
     2267                printf("Element id %i Jacobian determinant: %g\n",GetId(),Jdet);
     2268#endif
     2269
     2270                /* Get nodal functions value at gaussian point:*/
     2271                GetNodalFunctions(l1l2l3, gauss_l1l2l3);
     2272
     2273                /*Build due_g_gaussian vector: we have three cases here, according to which type of misfit we are using. */
     2274                if(fit==0){
     2275                        /*We are using an absolute misfit: */
     2276
     2277                        /*Compute absolute(x/y) at gaussian point: */
     2278                        GetParameterValue(&absolutex, &absolutex_list[0],gauss_l1l2l3);
     2279                        GetParameterValue(&absolutey, &absolutey_list[0],gauss_l1l2l3);
     2280
     2281                        /*compute Du*/
     2282                        for (i=0;i<numgrids;i++){
     2283                                due_g_gaussian[i*NDOF2+0]=absolutex*Jdet*gauss_weight*l1l2l3[i];
     2284                                due_g_gaussian[i*NDOF2+1]=absolutey*Jdet*gauss_weight*l1l2l3[i];
     2285                        }
     2286                }
     2287                else if(fit==1){
     2288                        /*We are using a relative misfit: */
     2289
     2290                        /*Compute relative(x/y) at gaussian point: */
     2291                        GetParameterValue(&relativex, &relativex_list[0],gauss_l1l2l3);
     2292                        GetParameterValue(&relativey, &relativey_list[0],gauss_l1l2l3);
     2293
     2294                        /*compute Du*/
     2295                        for (i=0;i<numgrids;i++){
     2296                                due_g_gaussian[i*NDOF2+0]=relativex*Jdet*gauss_weight*l1l2l3[i];
     2297                                due_g_gaussian[i*NDOF2+1]=relativey*Jdet*gauss_weight*l1l2l3[i];
     2298                        }
     2299                }
     2300                else if(fit==2){
     2301                        /*We are using a logarithmic misfit: */
     2302
     2303                        /*Compute logarithmic(x/y) at gaussian point: */
     2304                        GetParameterValue(&logarithmicx, &logarithmicx_list[0],gauss_l1l2l3);
     2305                        GetParameterValue(&logarithmicy, &logarithmicy_list[0],gauss_l1l2l3);
     2306
     2307                        /*compute Du*/
     2308                        for (i=0;i<numgrids;i++){
     2309                                due_g_gaussian[i*NDOF2+0]=logarithmicx*Jdet*gauss_weight*l1l2l3[i];
     2310                                due_g_gaussian[i*NDOF2+1]=logarithmicy*Jdet*gauss_weight*l1l2l3[i];
     2311                        }
     2312                }
     2313                else{
     2314                        /*Not supported yet! : */
     2315                        throw ErrorException(__FUNCT__,exprintf("%s%g","unsupported type of fit: ",fit));
     2316                }
     2317
     2318                /*Add due_g_gaussian vector to due_g: */
     2319                for( i=0; i<numdof; i++){
     2320                        due_g[i]+=due_g_gaussian[i];
     2321                }
     2322        }
     2323
     2324        /*Add due_g to global vector du_g: */
     2325        VecSetValues(du_g,numdof,doflist,(const double*)due_g,ADD_VALUES);
     2326
     2327cleanup_and_return:
     2328        xfree((void**)&first_gauss_area_coord);
     2329        xfree((void**)&second_gauss_area_coord);
     2330        xfree((void**)&third_gauss_area_coord);
     2331        xfree((void**)&gauss_weights);
     2332
     2333}
     2334/*}}}*/
     2335/*FUNCTION Echo {{{1*/
    1122336#undef __FUNCT__
    113 #define __FUNCT__ "Tria::DeepEcho"
    114 
    115 void Tria::DeepEcho(void){
     2337#define __FUNCT__ "Tria::Echo"
     2338
     2339void Tria::Echo(void){
    1162340
    1172341        printf("Tria:\n");
    … …  
    1462370}
    1472371/*}}}*/
    148 /*FUNCTION Marshall {{{1*/
    149 void  Tria::Marshall(char** pmarshalled_dataset){
    150 
    151         char* marshalled_dataset=NULL;
    152         int   enum_type=0;
    153 
    154         /*recover marshalled_dataset: */
    155         marshalled_dataset=*pmarshalled_dataset;
    156 
    157         /*get enum type of Tria: */
    158         enum_type=TriaEnum();
    159        
    160         /*marshall enum: */
    161         memcpy(marshalled_dataset,&enum_type,sizeof(enum_type));marshalled_dataset+=sizeof(enum_type);
    162        
    163         /*marshall Tria data: */
    164         memcpy(marshalled_dataset,&id,sizeof(id));marshalled_dataset+=sizeof(id);
    165         memcpy(marshalled_dataset,&mid,sizeof(mid));marshalled_dataset+=sizeof(mid);
    166         memcpy(marshalled_dataset,&mparid,sizeof(mparid));marshalled_dataset+=sizeof(mparid);
    167         memcpy(marshalled_dataset,&node_ids,sizeof(node_ids));marshalled_dataset+=sizeof(node_ids);
    168         memcpy(marshalled_dataset,&nodes,sizeof(nodes));marshalled_dataset+=sizeof(nodes);
    169         memcpy(marshalled_dataset,&node_offsets,sizeof(node_offsets));marshalled_dataset+=sizeof(node_offsets);
    170         memcpy(marshalled_dataset,&matice,sizeof(matice));marshalled_dataset+=sizeof(matice);
    171         memcpy(marshalled_dataset,&matice_offset,sizeof(matice_offset));marshalled_dataset+=sizeof(matice_offset);
    172         memcpy(marshalled_dataset,&matpar,sizeof(matpar));marshalled_dataset+=sizeof(matpar);
    173         memcpy(marshalled_dataset,&matpar_offset,sizeof(matpar_offset));marshalled_dataset+=sizeof(matpar_offset);
    174         memcpy(marshalled_dataset,&numparid,sizeof(numparid));marshalled_dataset+=sizeof(numparid);
    175         memcpy(marshalled_dataset,&numpar,sizeof(numpar));marshalled_dataset+=sizeof(numpar);
    176         memcpy(marshalled_dataset,&numpar_offset,sizeof(numpar_offset));marshalled_dataset+=sizeof(numpar_offset);
    177         memcpy(marshalled_dataset,&h,sizeof(h));marshalled_dataset+=sizeof(h);
    178         memcpy(marshalled_dataset,&s,sizeof(s));marshalled_dataset+=sizeof(s);
    179         memcpy(marshalled_dataset,&b,sizeof(b));marshalled_dataset+=sizeof(b);
    180         memcpy(marshalled_dataset,&k,sizeof(k));marshalled_dataset+=sizeof(k);
    181         memcpy(marshalled_dataset,&melting,sizeof(melting));marshalled_dataset+=sizeof(melting);
    182         memcpy(marshalled_dataset,&accumulation,sizeof(accumulation));marshalled_dataset+=sizeof(accumulation);
    183         memcpy(marshalled_dataset,&geothermalflux,sizeof(geothermalflux));marshalled_dataset+=sizeof(geothermalflux);
    184         memcpy(marshalled_dataset,&friction_type,sizeof(friction_type));marshalled_dataset+=sizeof(friction_type);
    185         memcpy(marshalled_dataset,&onbed,sizeof(onbed));marshalled_dataset+=sizeof(onbed);
    186         memcpy(marshalled_dataset,&onwater,sizeof(onwater));marshalled_dataset+=sizeof(onwater);
    187         memcpy(marshalled_dataset,&p,sizeof(p));marshalled_dataset+=sizeof(p);
    188         memcpy(marshalled_dataset,&q,sizeof(q));marshalled_dataset+=sizeof(q);
    189         memcpy(marshalled_dataset,&shelf,sizeof(shelf));marshalled_dataset+=sizeof(shelf);
    190        
    191         *pmarshalled_dataset=marshalled_dataset;
    192         return;
    193 }
    194 /*}}}*/
    195 /*FUNCTION MarshallSize {{{1*/
    196 int   Tria::MarshallSize(){
    197         return sizeof(id)
    198                 +sizeof(mid)
    199                 +sizeof(mparid)
    200                 +sizeof(node_ids)
    201                 +sizeof(nodes)
    202                 +sizeof(node_offsets)
    203                 +sizeof(matice)
    204                 +sizeof(matice_offset)
    205                 +sizeof(matpar)
    206                 +sizeof(matpar_offset)
    207                 +sizeof(numparid)
    208                 +sizeof(numpar)
    209                 +sizeof(numpar_offset)
    210                 +sizeof(h)
    211                 +sizeof(s)
    212                 +sizeof(b)
    213                 +sizeof(k)
    214                 +sizeof(melting)
    215                 +sizeof(accumulation)
    216                 +sizeof(geothermalflux)
    217                 +sizeof(friction_type)
    218                 +sizeof(onbed)
    219                 +sizeof(onwater)
    220                 +sizeof(p)
    221                 +sizeof(q)
    222                 +sizeof(shelf)
    223                 +sizeof(int); //sizeof(int) for enum type
    224 }
    225 /*}}}*/
    226 /*FUNCTION GetName {{{1*/
    227 char* Tria::GetName(void){
    228         return "tria";
    229 }
    230 /*}}}*/
    231 /*FUNCTION Demarshall {{{1*/
    232 void  Tria::Demarshall(char** pmarshalled_dataset){
    233 
    234         char* marshalled_dataset=NULL;
    235         int   i;
    236 
    237         /*recover marshalled_dataset: */
    238         marshalled_dataset=*pmarshalled_dataset;
    239 
    240         /*this time, no need to get enum type, the pointer directly points to the beginning of the
    241          *object data (thanks to DataSet::Demarshall):*/
    242 
    243         memcpy(&id,marshalled_dataset,sizeof(id));marshalled_dataset+=sizeof(id);
    244         memcpy(&mid,marshalled_dataset,sizeof(mid));marshalled_dataset+=sizeof(mid);
    245         memcpy(&mparid,marshalled_dataset,sizeof(mparid));marshalled_dataset+=sizeof(mparid);
    246         memcpy(&node_ids,marshalled_dataset,sizeof(node_ids));marshalled_dataset+=sizeof(node_ids);
    247         memcpy(&nodes,marshalled_dataset,sizeof(nodes));marshalled_dataset+=sizeof(nodes);
    248         memcpy(&node_offsets,marshalled_dataset,sizeof(node_offsets));marshalled_dataset+=sizeof(node_offsets);
    249         memcpy(&matice,marshalled_dataset,sizeof(matice));marshalled_dataset+=sizeof(matice);
    250         memcpy(&matice_offset,marshalled_dataset,sizeof(matice_offset));marshalled_dataset+=sizeof(matice_offset);
    251         memcpy(&matpar,marshalled_dataset,sizeof(matpar));marshalled_dataset+=sizeof(matpar);
    252         memcpy(&matpar_offset,marshalled_dataset,sizeof(matpar_offset));marshalled_dataset+=sizeof(matpar_offset);
    253         memcpy(&numparid,marshalled_dataset,sizeof(numparid));marshalled_dataset+=sizeof(numparid);
    254         memcpy(&numpar,marshalled_dataset,sizeof(numpar));marshalled_dataset+=sizeof(numpar);
    255         memcpy(&numpar_offset,marshalled_dataset,sizeof(numpar_offset));marshalled_dataset+=sizeof(numpar_offset);
    256         memcpy(&h,marshalled_dataset,sizeof(h));marshalled_dataset+=sizeof(h);
    257         memcpy(&s,marshalled_dataset,sizeof(s));marshalled_dataset+=sizeof(s);
    258         memcpy(&b,marshalled_dataset,sizeof(b));marshalled_dataset+=sizeof(b);
    259         memcpy(&k,marshalled_dataset,sizeof(k));marshalled_dataset+=sizeof(k);
    260         memcpy(&melting,marshalled_dataset,sizeof(melting));marshalled_dataset+=sizeof(melting);
    261         memcpy(&accumulation,marshalled_dataset,sizeof(accumulation));marshalled_dataset+=sizeof(accumulation);
    262         memcpy(&geothermalflux,marshalled_dataset,sizeof(geothermalflux));marshalled_dataset+=sizeof(geothermalflux);
    263         memcpy(&friction_type,marshalled_dataset,sizeof(friction_type));marshalled_dataset+=sizeof(friction_type);
    264         memcpy(&onbed,marshalled_dataset,sizeof(onbed));marshalled_dataset+=sizeof(onbed);
    265         memcpy(&onwater,marshalled_dataset,sizeof(onwater));marshalled_dataset+=sizeof(onwater);
    266         memcpy(&p,marshalled_dataset,sizeof(p));marshalled_dataset+=sizeof(p);
    267         memcpy(&q,marshalled_dataset,sizeof(q));marshalled_dataset+=sizeof(q);
    268         memcpy(&shelf,marshalled_dataset,sizeof(shelf));marshalled_dataset+=sizeof(shelf);
    269 
    270         /*nodes and materials are not pointing to correct objects anymore:*/
    271         for(i=0;i<3;i++)nodes[i]=NULL;
    272         matice=NULL;
    273         matpar=NULL;
    274         numpar=NULL;
    275 
    276         /*return: */
    277         *pmarshalled_dataset=marshalled_dataset;
    278         return;
    279 }
    280 /*}}}*/
    2812372/*FUNCTION Enum {{{1*/
    2822373int Tria::Enum(void){
    … …  
    2862377}
    2872378/*}}}*/
    288 /*FUNCTION GetId {{{1*/
    289 int    Tria::GetId(){ return id; }
    290 /*}}}*/
    291 /*FUNCTION MyRank {{{1*/
    292 int    Tria::MyRank(void){
    293         extern int my_rank;
    294         return my_rank;
    295 }
    296 /*}}}*/
    297 /*FUNCTION Configure {{{1*/
    298 #undef __FUNCT__
    299 #define __FUNCT__ "Tria::Configure"
    300 void  Tria::Configure(void* ploadsin,void* pnodesin,void* pmaterialsin,void* pparametersin){
    301 
     2379/*FUNCTION GetArea {{{1*/
     2380#undef __FUNCT__
     2381#define __FUNCT__ "Tria::GetArea"
     2382double Tria::GetArea(void){
     2383
     2384        double area=0;
     2385        const int    numgrids=3;
     2386        double xyz_list[numgrids][3];
     2387        double x1,y1,x2,y2,x3,y3;
     2388
     2389        /*Get xyz list: */
     2390        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     2391        x1=xyz_list[0][0]; y1=xyz_list[0][1];
     2392        x2=xyz_list[1][0]; y2=xyz_list[1][1];
     2393        x3=xyz_list[2][0]; y3=xyz_list[2][1];
     2394 
     2395        return x2*y3 - y2*x3 + x1*y2 - y1*x2 + x3*y1 - y3*x1;
     2396}
     2397/*}}}*/
     2398/*FUNCTION GetAreaCoordinate {{{1*/
     2399#undef __FUNCT__
     2400#define __FUNCT__ "Tria::GetAreaCoordinate"
     2401double Tria::GetAreaCoordinate(double x, double y, int which_one){
     2402
     2403        double area=0;
     2404        const int    numgrids=3;
     2405        double xyz_list[numgrids][3];
     2406        double x1,y1,x2,y2,x3,y3;
     2407
     2408        /*Get area: */
     2409        area=this->GetArea();
     2410
     2411        /*Get xyz list: */
     2412        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
     2413        x1=xyz_list[0][0]; y1=xyz_list[0][1];
     2414        x2=xyz_list[1][0]; y2=xyz_list[1][1];
     2415        x3=xyz_list[2][0]; y3=xyz_list[2][1];
     2416
     2417        if(which_one==1){
     2418                /*Get first area coordinate = det(x-x3  x2-x3 ; y-y3   y2-y3)/area*/
     2419                return ((x-x3)*(y2-y3)-(x2-x3)*(y-y3))/area;
     2420        }
     2421        else if(which_one==2){
     2422                /*Get second area coordinate = det(x1-x3  x-x3 ; y1-y3   y-y3)/area*/
     2423                return ((x1-x3)*(y-y3)-(x-x3)*(y1-y3))/area;
     2424        }
     2425        else if(which_one==3){
     2426                /*Get third  area coordinate 1-area1-area2: */
     2427                return 1-((x-x3)*(y2-y3)-(x2-x3)*(y-y3))/area -((x1-x3)*(y-y3)-(x-x3)*(y1-y3))/area;
     2428        }
     2429        else throw ErrorException(__FUNCT__,exprintf("%s%i%s\n"," error message: area coordinate ",which_one," done not exist!"));
     2430}
     2431/*}}}*/
     2432/*FUNCTION GetB {{{1*/
     2433#undef __FUNCT__
     2434#define __FUNCT__ "Tria::GetB"
     2435
     2436void Tria::GetB(double* B, double* xyz_list, double* gauss_l1l2l3){
     2437
     2438        /*Compute B  matrix. B=[B1 B2 B3] where Bi is of size 3*NDOF2.
     2439         * For grid i, Bi can be expressed in the basic coordinate system
     2440         * by:
     2441         *       Bi_basic=[ dh/dx    0    ]
     2442         *                [   0    dh/dy  ]
     2443         *                [ 1/2*dh/dy  1/2*dh/dx  ]
     2444         * where h is the interpolation function for grid i.
     2445         *
     2446         * We assume B has been allocated already, of size: 3x(NDOF2*numgrids)
     2447         */
     2448       
    3022449        int i;
    303        
    304         DataSet* loadsin=NULL;
    305         DataSet* nodesin=NULL;
    306         DataSet* materialsin=NULL;
    307         DataSet* parametersin=NULL;
    308 
    309         /*Recover pointers :*/
    310         loadsin=(DataSet*)ploadsin;
    311         nodesin=(DataSet*)pnodesin;
    312         materialsin=(DataSet*)pmaterialsin;
    313         parametersin=(DataSet*)pparametersin;
    314 
    315         /*Link this element with its nodes, ie find pointers to the nodes in the nodes dataset.: */
    316         ResolvePointers((Object**)nodes,node_ids,node_offsets,3,nodesin);
    317        
    318         /*Same for materials: */
    319         ResolvePointers((Object**)&matice,&mid,&matice_offset,1,materialsin);
    320         ResolvePointers((Object**)&matpar,&mparid,&matpar_offset,1,materialsin);
    321 
    322         /*Same for numpar: */
    323         ResolvePointers((Object**)&numpar,&numparid,&numpar_offset,1,parametersin);
    324 
    325 }
    326 /*}}}*/
    327 /*FUNCTION CreateKMatrix {{{1*/
    328 #undef __FUNCT__
    329 #define __FUNCT__ "Tria::CreateKMatrix"
    330 
    331 void  Tria::CreateKMatrix(Mat Kgg,void* inputs,int analysis_type,int sub_analysis_type){
    332 
    333         /*Just branch to the correct element stiffness matrix generator, according to the type of analysis we are carrying out: */
    334         if (analysis_type==ControlAnalysisEnum()){
    335                
    336                 CreateKMatrixDiagnosticHoriz( Kgg,inputs,analysis_type,sub_analysis_type);
    337         }
    338         else if (analysis_type==DiagnosticAnalysisEnum()){
    339        
    340                 if (sub_analysis_type==HorizAnalysisEnum()){
    341 
    342                         CreateKMatrixDiagnosticHoriz( Kgg,inputs,analysis_type,sub_analysis_type);
    343                 }
    344                 else throw ErrorException(__FUNCT__,exprintf("%s%i%s\n","sub_analysis: ",sub_analysis_type," not supported yet"));
    345 
    346         }
    347         else if (analysis_type==SlopeComputeAnalysisEnum()){
    348 
    349                 CreateKMatrixSlopeCompute( Kgg,inputs,analysis_type,sub_analysis_type);
    350 
    351         }
    352         else if (analysis_type==PrognosticAnalysisEnum()){
    353 
    354                 CreateKMatrixPrognostic( Kgg,inputs,analysis_type,sub_analysis_type);
    355 
    356         }
    357         else{
    358                 throw ErrorException(__FUNCT__,exprintf("%s%i%s\n","analysis: ",analysis_type," not supported yet"));
    359         }
    360 
    361 }
    362 /*}}}*/
    363 /*FUNCTION CreateKMatrixDiagnosticHoriz {{{1*/
    364 #undef __FUNCT__
    365 #define __FUNCT__ "Tria::CreateKMatrixDiagnosticHoriz"
    366 
    367 void  Tria::CreateKMatrixDiagnosticHoriz(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
    368 
    369 
    370         /* local declarations */
    371         int             i,j;
    372 
    373         /* node data: */
    374         const int    numgrids=3;
    375         const int    numdof=2*numgrids;
    376         double       xyz_list[numgrids][3];
    377         int          doflist[numdof];
    378         int          numberofdofspernode;
    379        
    380         /* gaussian points: */
    381         int     num_gauss,ig;
    382         double* first_gauss_area_coord  =  NULL;
    383         double* second_gauss_area_coord =  NULL;
    384         double* third_gauss_area_coord  =  NULL;
    385         double* gauss_weights           =  NULL;
    386         double  gauss_weight;
    387         double  gauss_l1l2l3[3];
    388 
    389         /* material data: */
    390         double viscosity; //viscosity
    391         double newviscosity; //viscosity
    392         double oldviscosity; //viscosity
    393        
    394         /* strain rate: */
    395         double epsilon[3]; /* epsilon=[exx,eyy,exy];*/
    396         double oldepsilon[3]; /* oldepsilon=[exx,eyy,exy];*/
    397 
    398         /* matrices: */
    399         double B[3][numdof];
    400         double Bprime[3][numdof];
    401         double D[3][3]={{ 0,0,0 },{0,0,0},{0,0,0}};              // material matrix, simple scalar matrix.
    402         double D_scalar;
    403 
    404         /* local element matrices: */
    405         double Ke_gg[numdof][numdof]; //local element stiffness matrix
    406         double Ke_gg_gaussian[numdof][numdof]; //stiffness matrix evaluated at the gaussian point.
    407        
    408         double Jdet;
    409        
    410         /*input parameters for structural analysis (diagnostic): */
    411         double  vxvy_list[numgrids][2]={{0,0},{0,0},{0,0}};
    412         double  oldvxvy_list[numgrids][2]={{0,0},{0,0},{0,0}};
    413         double  thickness;
    414         int     dofs[2]={0,1};
    415 
    416         ParameterInputs* inputs=NULL;
    417 
    418         /*First, if we are on water, return empty matrix: */
    419         if(onwater)return;
    420 
    421         /*recover pointers: */
    422         inputs=(ParameterInputs*)vinputs;
    423 
    424         /*recover extra inputs from users, at current convergence iteration: */
    425         inputs->Recover("velocity",&vxvy_list[0][0],2,dofs,numgrids,(void**)nodes);
    426         inputs->Recover("old_velocity",&oldvxvy_list[0][0],2,dofs,numgrids,(void**)nodes);
    427 
    428         /* Get node coordinates and dof list: */
    429         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    430         GetDofList(&doflist[0],&numberofdofspernode);
    431 
    432         /* Set Ke_gg to 0: */
    433         for(i=0;i<numdof;i++) for(j=0;j<numdof;j++) Ke_gg[i][j]=0.0;
    434 
    435         #ifdef _DEBUGELEMENTS_
    436         if(my_rank==RANK && id==ELID){
    437                 printf("El id %i Rank %i TriaElemnet input list before gaussian loop: \n",ELID,RANK);
    438                 printf("   rho_ice: %g \n",matpar->GetRhoIce());
    439                 printf("   gravity: %g \n",matpar->GetG())
    440                 printf("   rho_water: %g \n",matpar->GetRhoWater());
    441                 printf("   Velocity: \n");
    442                 for (i=0;i<numgrids;i++){
    443                         printf("      node %i  [%g,%g]\n",i,vxvy_list[i][0],vxvy_list[i][1]);
    444                 }
    445                 printf("   flow_law_parameter [%g ]\n",matice->GetB());
    446                 printf("   drag [%g %g %g ]\n",k[0],k[1],k[2]);
    447                 printf("   thickness [%g %g %g]\n",h[0],h[1],h[2]);
    448                 printf("   surface [%g %g %g ]\n",s[0],s[1],s[2]);
    449                 printf("   bed [%g %g %g]\n",b[0],b[1],b[2]);
     2450        const int NDOF2=2;
     2451        const int numgrids=3;
     2452
     2453        double dh1dh2dh3_basic[NDOF2][numgrids];
     2454
     2455
     2456        /*Get dh1dh2dh3 in basic coordinate system: */
     2457        GetNodalFunctionsDerivativesBasic(&dh1dh2dh3_basic[0][0],xyz_list, gauss_l1l2l3);
     2458
     2459        #ifdef _ISSM_DEBUG_
     2460        for (i=0;i<3;i++){
     2461                printf("Node %i  dh/dx=%lf dh/dy=%lf \n",i,dh1dh2dh3_basic[0][i],dh1dh2dh3_basic[1][i]);
    4502462        }
    4512463        #endif
    4522464
    453 
    454         /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
    455         GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
    456 
    457         #ifdef _DEBUGELEMENTS_
    458         if(my_rank==RANK && id==ELID){
    459                 printf("   gaussian points: \n");
    460                 for(i=0;i<num_gauss;i++){
    461                         printf("    %g %g %g : %g\n",first_gauss_area_coord[i],second_gauss_area_coord[i],third_gauss_area_coord[i],gauss_weights[i]);
    462                 }
    463         }
    464         #endif
    465 
    466         /* Start  looping on the number of gaussian points: */
    467         for (ig=0; ig<num_gauss; ig++){
    468                 /*Pick up the gaussian point: */
    469                 gauss_weight=*(gauss_weights+ig);
    470                 gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
    471                 gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
    472                 gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
    473 
    474 
    475                 /*Compute thickness at gaussian point: */
    476                 GetParameterValue(&thickness, &h[0],gauss_l1l2l3);
    477 
    478                 /*Get strain rate from velocity: */
    479                 GetStrainRate(&epsilon[0],&vxvy_list[0][0],&xyz_list[0][0],gauss_l1l2l3);
    480                 GetStrainRate(&oldepsilon[0],&oldvxvy_list[0][0],&xyz_list[0][0],gauss_l1l2l3);
    481                
    482                 /*Get viscosity: */
    483                 matice->GetViscosity2d(&viscosity, &epsilon[0]);
    484                 matice->GetViscosity2d(&oldviscosity, &oldepsilon[0]);
    485                
    486                 /* Get Jacobian determinant: */
    487                 GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
    488 
    489                 /* Build the D matrix: we plug the gaussian weight, the thickness, the viscosity, and the jacobian determinant
    490                    onto this scalar matrix, so that we win some computational time: */
    491                 newviscosity=viscosity+numpar->viscosity_overshoot*(viscosity-oldviscosity);
    492                 D_scalar=newviscosity*thickness*gauss_weight*Jdet;
    493 
    494                 for (i=0;i<3;i++){
    495                         D[i][i]=D_scalar;
    496                 }
    497                
    498                 #ifdef _DEBUGELEMENTS_
    499                 if(my_rank==RANK && id==ELID){
    500                         printf("   gaussian loop %i\n",ig);
    501                         printf("      thickness %g\n",thickness);
    502                         printf("      slope [%g,%g]\n",slope[0],slope[1]);
    503                         printf("      alpha2_list [%g,%g,%g]\n",alpha2_list[0],alpha2_list[1],alpha2_list[2]);
    504                         printf("      epsilon [%g,%g,%g]\n",epsilon[0],epsilon[1],epsilon[2]);
    505                         printf("      Matice: \n");
    506                         matice->Echo();
    507                         printf("      Matpar: \n");
    508                         matpar->Echo();
    509                         printf("\n    viscosity: %g \n",viscosity);
    510                         printf("      jacobian: %g \n",Jdet);
    511                         printf("      gauss_weight: %g \n",gauss_weight);
    512                 }
    513                 #endif
    514 
    515                 /*Get B and Bprime matrices: */
    516                 GetB(&B[0][0], &xyz_list[0][0], gauss_l1l2l3);
    517                 GetBPrime(&Bprime[0][0], &xyz_list[0][0], gauss_l1l2l3);
    518 
    519                 /*  Do the triple product tB*D*Bprime: */
    520                 TripleMultiply( &B[0][0],3,numdof,1,
    521                                           &D[0][0],3,3,0,
    522                                           &Bprime[0][0],3,numdof,0,
    523                                           &Ke_gg_gaussian[0][0],0);
    524 
    525                 /* Add the Ke_gg_gaussian, and optionally Ke_gg_drag_gaussian onto Ke_gg: */
    526                 for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_gaussian[i][j];
    527                
    528                 #ifdef _DEBUGELEMENTS_
    529                 if(my_rank==RANK && id==ELID){
    530                         printf("      B:\n");
    531                         for(i=0;i<3;i++){
    532                                 for(j=0;j<numdof;j++){
    533                                         printf("%g ",B[i][j]);
    534                                 }
    535                                 printf("\n");
    536                         }
    537                         printf("      Bprime:\n");
    538                         for(i=0;i<3;i++){
    539                                 for(j=0;j<numdof;j++){
    540                                         printf("%g ",Bprime[i][j]);
    541                                 }
    542                                 printf("\n");
    543                         }
    544                 }
    545                 #endif
    546         } // for (ig=0; ig<num_gauss; ig++)
    547 
    548         /*Add Ke_gg to global matrix Kgg: */
    549         MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)Ke_gg,ADD_VALUES);
    550 
    551 
    552         /*Do not forget to include friction: */
    553         if(!shelf){
    554                 CreateKMatrixDiagnosticHorizFriction(Kgg,inputs,analysis_type,sub_analysis_type);
    555         }
    556 
    557         #ifdef _DEBUGELEMENTS_
    558         if(my_rank==RANK && id==ELID){
    559                 printf("      Ke_gg erms:\n");
    560                 for( i=0; i<numdof; i++){
    561                         for (j=0;j<numdof;j++){
    562                                 printf("%g ",Ke_gg[i][j]);
    563                         }
    564                         printf("\n");
    565                 }
    566                 printf("      Ke_gg row_indices:\n");
    567                 for( i=0; i<numdof; i++){
    568                         printf("%i ",doflist[i]);
    569                 }
    570 
    571         }
    572         #endif
    573 
    574         cleanup_and_return:
    575         xfree((void**)&first_gauss_area_coord);
    576         xfree((void**)&second_gauss_area_coord);
    577         xfree((void**)&third_gauss_area_coord);
    578         xfree((void**)&gauss_weights);
    579 
    580 }
    581 /*}}}*/
    582 /*FUNCTION CreateKMatrixPrognostic {{{1*/
    583 #undef __FUNCT__
    584 #define __FUNCT__ "Tria::CreateKMatrixPrognostic"
    585 void  Tria::CreateKMatrixPrognostic(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
    586 
    587 
    588         /* local declarations */
    589         int             i,j;
    590 
    591         /* node data: */
    592         const int    numgrids=3;
    593         const int    NDOF1=1;
    594         const int    numdof=NDOF1*numgrids;
    595         double       xyz_list[numgrids][3];
    596         int          doflist[numdof];
    597         int          numberofdofspernode;
    598        
    599         /* gaussian points: */
    600         int     num_gauss,ig;
    601         double* first_gauss_area_coord  =  NULL;
    602         double* second_gauss_area_coord =  NULL;
    603         double* third_gauss_area_coord  =  NULL;
    604         double* gauss_weights           =  NULL;
    605         double  gauss_weight;
    606         double  gauss_l1l2l3[3];
    607 
    608         /* matrices: */
    609         double L[numgrids];
    610         double B[2][numgrids];
    611         double Bprime[2][numgrids];
    612         double DL[2][2]={0.0};
    613         double DLprime[2][2]={0.0};
    614         double DL_scalar;
    615         double Ke_gg[numdof][numdof]={0.0};//local element stiffness matrix
    616         double Ke_gg_gaussian[numdof][numdof]={0.0}; //stiffness matrix evaluated at the gaussian point.
    617         double Ke_gg_thickness1[numdof][numdof]={0.0}; //stiffness matrix evaluated at the gaussian point.
    618         double Ke_gg_thickness2[numdof][numdof]={0.0}; //stiffness matrix evaluated at the gaussian point.
    619        
    620         double Jdettria;
    621        
    622         /*input parameters for structural analysis (diagnostic): */
    623         double  vxvy_list[numgrids][2]={0.0};
    624         double  vx_list[numgrids]={0.0};
    625         double  vy_list[numgrids]={0.0};
    626         double  dvx[2];
    627         double  dvy[2];
    628         double  vx,vy;
    629         double  dvxdx,dvydy;
    630         double  v_gauss[2]={0.0};
    631         double  K[2][2]={0.0};
    632         double  KDL[2][2]={0.0};
    633         double  dt;
    634         int     dofs[2]={0,1};
    635         int     found=0;
    636 
    637         ParameterInputs* inputs=NULL;
    638 
    639         /*recover pointers: */
    640         inputs=(ParameterInputs*)vinputs;
    641 
    642         /*recover extra inputs from users, at current convergence iteration: */
    643         found=inputs->Recover("velocity_average",&vxvy_list[0][0],2,dofs,numgrids,(void**)nodes);
    644         if(!found)throw ErrorException(__FUNCT__," could not find velocity_average  in inputs!");
    645 
    646         for(i=0;i<numgrids;i++){
    647                 vx_list[i]=vxvy_list[i][0];
    648                 vy_list[i]=vxvy_list[i][1];
    649         }
    650        
    651         found=inputs->Recover("dt",&dt);
    652         if(!found)throw ErrorException(__FUNCT__," could not find dt in inputs!");
    653 
    654         /* Get node coordinates and dof list: */
    655         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    656         GetDofList(&doflist[0],&numberofdofspernode);
    657 
    658         //Create Artificial diffusivity once for all if requested
    659         if(numpar->artdiff){
    660                 //Get the Jacobian determinant
    661                 gauss_l1l2l3[0]=1.0/3.0; gauss_l1l2l3[1]=1.0/3.0; gauss_l1l2l3[2]=1.0/3.0;
    662                 GetJacobianDeterminant2d(&Jdettria, &xyz_list[0][0],gauss_l1l2l3);
    663 
    664                 //Build K matrix (artificial diffusivity matrix)
    665                 v_gauss[0]=1.0/3.0*(vxvy_list[0][0]+vxvy_list[1][0]+vxvy_list[2][0]);
    666                 v_gauss[1]=1.0/3.0*(vxvy_list[0][1]+vxvy_list[1][1]+vxvy_list[2][1]);
    667                
    668                 K[0][0]=pow(Jdettria,(double).5)/2.0*fabs(v_gauss[0]);
    669                 K[1][1]=pow(Jdettria,(double).5)/2.0*fabs(v_gauss[1]);
    670         }
    671 
    672         /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
    673         GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
    674 
    675         /* Start  looping on the number of gaussian points: */
    676         for (ig=0; ig<num_gauss; ig++){
    677                 /*Pick up the gaussian point: */
    678                 gauss_weight=*(gauss_weights+ig);
    679                 gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
    680                 gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
    681                 gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
    682 
    683                 /* Get Jacobian determinant: */
    684                 GetJacobianDeterminant2d(&Jdettria, &xyz_list[0][0],gauss_l1l2l3);
    685 
    686                 /*Get L matrix: */
    687                 GetL(&L[0], &xyz_list[0][0], gauss_l1l2l3,numberofdofspernode);
    688 
    689                 DL_scalar=gauss_weight*Jdettria;
    690 
    691                 /*  Do the triple product tL*D*L: */
    692                 TripleMultiply( &L[0],1,numdof,1,
    693                                           &DL_scalar,1,1,0,
    694                                           &L[0],1,numdof,0,
    695                                           &Ke_gg_gaussian[0][0],0);
    696                
    697                 /*Get B  and B prime matrix: */
    698                 GetB_prog(&B[0][0], &xyz_list[0][0], gauss_l1l2l3);
    699                 GetBPrime_prog(&Bprime[0][0], &xyz_list[0][0], gauss_l1l2l3);
    700                
    701                 //Get vx, vy and their derivatives at gauss point
    702                 GetParameterValue(&vx, &vx_list[0],gauss_l1l2l3);
    703                 GetParameterValue(&vy, &vy_list[0],gauss_l1l2l3);
    704                
    705                 GetParameterDerivativeValue(&dvx[0], &vx_list[0],&xyz_list[0][0], gauss_l1l2l3);
    706                 GetParameterDerivativeValue(&dvy[0], &vy_list[0],&xyz_list[0][0], gauss_l1l2l3);
    707 
    708                 dvxdx=dvx[0];
    709                 dvydy=dvy[1];
    710 
    711                 DL_scalar=dt*gauss_weight*Jdettria;
    712 
    713                 //Create DL and DLprime matrix
    714                 DL[0][0]=DL_scalar*dvxdx;
    715                 DL[1][1]=DL_scalar*dvydy;
    716 
    717                 DLprime[0][0]=DL_scalar*vx;
    718                 DLprime[1][1]=DL_scalar*vy;
    719 
    720                 //Do the triple product tL*D*L.
    721                 //Ke_gg_thickness=B'*DL*B+B'*DLprime*Bprime;
    722 
    723                 TripleMultiply( &B[0][0],2,numdof,1,
    724                                           &DL[0][0],2,2,0,
    725                                           &B[0][0],2,numdof,0,
    726                                           &Ke_gg_thickness1[0][0],0);
    727 
    728                 TripleMultiply( &B[0][0],2,numdof,1,
    729                                           &DLprime[0][0],2,2,0,
    730                                           &Bprime[0][0],2,numdof,0,
    731                                           &Ke_gg_thickness2[0][0],0);
    732 
    733                 /* Add the Ke_gg_gaussian, and optionally Ke_gg_drag_gaussian onto Ke_gg: */
    734                 for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_gaussian[i][j];
    735                 for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_thickness1[i][j];
    736                 for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_thickness2[i][j];
    737                
    738                 if(numpar->artdiff){
    739                        
    740                         /* Compute artificial diffusivity */
    741                         KDL[0][0]=DL_scalar*K[0][0];
    742                         KDL[1][1]=DL_scalar*K[1][1];
    743 
    744                         TripleMultiply( &Bprime[0][0],2,numdof,1,
    745                                                   &KDL[0][0],2,2,0,
    746                                                   &Bprime[0][0],2,numdof,0,
    747                                                   &Ke_gg_gaussian[0][0],0);
    748 
    749                         /* Add artificial diffusivity matrix */
    750                         for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_gaussian[i][j];
    751                        
    752                 }
    753 
    754                 #ifdef _DEBUGELEMENTS_
    755                 if(my_rank==RANK && id==ELID){
    756                         printf("      B:\n");
    757                         for(i=0;i<3;i++){
    758                                 for(j=0;j<numdof;j++){
    759                                         printf("%g ",B[i][j]);
    760                                 }
    761                                 printf("\n");
    762                         }
    763                         printf("      Bprime:\n");
    764                         for(i=0;i<3;i++){
    765                                 for(j=0;j<numdof;j++){
    766                                         printf("%g ",Bprime[i][j]);
    767                                 }
    768                                 printf("\n");
    769                         }
    770                 }
    771                 #endif
    772         } // for (ig=0; ig<num_gauss; ig++)
    773 
    774         /*Add Ke_gg to global matrix Kgg: */
    775         MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)Ke_gg,ADD_VALUES);
    776 
    777         #ifdef _DEBUGELEMENTS_
    778         if(my_rank==RANK && id==ELID){
    779                 printf("      Ke_gg erms:\n");
    780                 for( i=0; i<numdof; i++){
    781                         for (j=0;j<numdof;j++){
    782                                 printf("%g ",Ke_gg[i][j]);
    783                         }
    784                         printf("\n");
    785                 }
    786                 printf("      Ke_gg row_indices:\n");
    787                 for( i=0; i<numdof; i++){
    788                         printf("%i ",doflist[i]);
    789                 }
    790 
    791         }
    792         #endif
    793 
    794         cleanup_and_return:
    795         xfree((void**)&first_gauss_area_coord);
    796         xfree((void**)&second_gauss_area_coord);
    797         xfree((void**)&third_gauss_area_coord);
    798         xfree((void**)&gauss_weights);
    799 
    800 }
    801 /*}}}*/
    802 /*FUNCTION CreateKMatrixDiagnosticHorizFriction {{{1*/
    803 #undef __FUNCT__
    804 #define __FUNCT__ "Tria::CreateKMatrixDiagnosticHorizFriction"
    805 void  Tria::CreateKMatrixDiagnosticHorizFriction(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
    806 
    807 
    808         /* local declarations */
    809         int             i,j;
    810 
    811         /* node data: */
    812         const int    numgrids=3;
    813         const int    numdof=2*numgrids;
    814         double       xyz_list[numgrids][3];
    815         int          doflist[numdof];
    816         int          numberofdofspernode;
    817        
    818         /* gaussian points: */
    819         int     num_gauss,ig;
    820         double* first_gauss_area_coord  =  NULL;
    821         double* second_gauss_area_coord =  NULL;
    822         double* third_gauss_area_coord  =  NULL;
    823         double* gauss_weights           =  NULL;
    824         double  gauss_weight;
    825         double  gauss_l1l2l3[3];
    826 
    827         /* matrices: */
    828         double L[2][numdof];
    829         double DL[2][2]={{ 0,0 },{0,0}}; //for basal drag
    830         double DL_scalar;
    831 
    832         /* local element matrices: */
    833         double Ke_gg[numdof][numdof]; //local element stiffness matrix
    834         double Ke_gg_gaussian[numdof][numdof]; //stiffness matrix contribution from drag
    835        
    836         double Jdet;
    837        
    838         /*slope: */
    839         double  slope[2]={0.0,0.0};
    840         double  slope_magnitude;
    841 
    842         /*input parameters for structural analysis (diagnostic): */
    843         double  vxvy_list[numgrids][2]={{0,0},{0,0},{0,0}};
    844         int     dofs[2]={0,1};
    845 
    846         /*friction: */
    847         double alpha2_list[numgrids]={0.0,0.0,0.0};
    848         double alpha2;
    849 
    850         double MAXSLOPE=.06; // 6 %
    851         double MOUNTAINKEXPONENT=10;
    852 
    853         ParameterInputs* inputs=NULL;
    854 
    855         /*recover pointers: */
    856         inputs=(ParameterInputs*)vinputs;
    857        
    858         /* Get node coordinates and dof list: */
    859         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    860         GetDofList(&doflist[0],&numberofdofspernode);
    861 
    862         /* Set Ke_gg to 0: */
    863         for(i=0;i<numdof;i++) for(j=0;j<numdof;j++) Ke_gg[i][j]=0.0;
    864 
    865         if (shelf){
    866                 /*no friction, do nothing*/
    867                 return;
    868         }
    869 
    870         if (friction_type!=2)throw ErrorException(__FUNCT__," non-viscous friction not supported yet!");
    871 
    872         /*recover extra inputs from users, at current convergence iteration: */
    873         inputs->Recover("velocity",&vxvy_list[0][0],2,dofs,numgrids,(void**)nodes);
    874 
    875         /*Build alpha2_list used by drag stiffness matrix*/
    876         Friction* friction=NewFriction();
    877        
    878         /*Initialize all fields: */
    879         friction->element_type=(char*)xmalloc((strlen("2d")+1)*sizeof(char));
    880         strcpy(friction->element_type,"2d");
    881        
    882         friction->gravity=matpar->GetG();
    883         friction->rho_ice=matpar->GetRhoIce();
    884         friction->rho_water=matpar->GetRhoWater();
    885         friction->K=&k[0];
    886         friction->bed=&b[0];
    887         friction->thickness=&h[0];
    888         friction->velocities=&vxvy_list[0][0];
    889         friction->p=p;
    890         friction->q=q;
    891 
    892         /*Compute alpha2_list: */
    893         FrictionGetAlpha2(&alpha2_list[0],friction);
    894 
    895         /*Erase friction object: */
    896         DeleteFriction(&friction);
    897 
    898         #ifdef _DEBUGELEMENTS_
    899         if(my_rank==RANK && id==ELID){
    900                 printf("   alpha2_list [%g %g %g ]\n",alpha2_list[0],alpha2_list[1],alpha2_list[2]);
    901         }
    902         #endif
    903 
    904         /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
    905         GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
    906 
    907         #ifdef _DEBUGELEMENTS_
    908         if(my_rank==RANK && id==ELID){
    909                 printf("   gaussian points: \n");
    910                 for(i=0;i<num_gauss;i++){
    911                         printf("    %g %g %g : %g\n",first_gauss_area_coord[i],second_gauss_area_coord[i],third_gauss_area_coord[i],gauss_weights[i]);
    912                 }
    913         }
    914         #endif
    915 
    916         /* Start  looping on the number of gaussian points: */
    917         for (ig=0; ig<num_gauss; ig++){
    918                 /*Pick up the gaussian point: */
    919                 gauss_weight=*(gauss_weights+ig);
    920                 gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
    921                 gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
    922                 gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
    923 
    924 
    925                 // If we have a slope > 6% for this element,  it means  we are on a mountain. In this particular case,
    926                 //velocity should be = 0. To achieve this result, we set alpha2_list to a very high value: */
    927                 GetParameterDerivativeValue(&slope[0], &s[0],&xyz_list[0][0], gauss_l1l2l3);
    928                 slope_magnitude=sqrt(pow(slope[0],2)+pow(slope[1],2));
    929 
    930                 if (slope_magnitude>MAXSLOPE){
    931                         alpha2_list[0]=pow((double)10,MOUNTAINKEXPONENT);
    932                         alpha2_list[1]=pow((double)10,MOUNTAINKEXPONENT);
    933                         alpha2_list[2]=pow((double)10,MOUNTAINKEXPONENT);
    934                 }
    935 
    936                 /* Get Jacobian determinant: */
    937                 GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
    938 
    939                 /*Get L matrix: */
    940                 GetL(&L[0][0], &xyz_list[0][0], gauss_l1l2l3,numberofdofspernode);
    941 
    942                 /*Now, take care of the basal friction if there is any: */
    943                 GetParameterValue(&alpha2, &alpha2_list[0],gauss_l1l2l3);
    944 
    945                 DL_scalar=alpha2*gauss_weight*Jdet;
    946                 for (i=0;i<2;i++){
    947                         DL[i][i]=DL_scalar;
    948                 }
    949                
    950                 /*  Do the triple producte tL*D*L: */
    951                 TripleMultiply( &L[0][0],2,numdof,1,
    952                                         &DL[0][0],2,2,0,
    953                                         &L[0][0],2,numdof,0,
    954                                         &Ke_gg_gaussian[0][0],0);
    955 
    956                 for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_gaussian[i][j];
    957 
    958         } // for (ig=0; ig<num_gauss; ig++)
    959 
    960         /*Add Ke_gg to global matrix Kgg: */
    961         MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)Ke_gg,ADD_VALUES);
    962 
    963         cleanup_and_return:
    964         xfree((void**)&first_gauss_area_coord);
    965         xfree((void**)&second_gauss_area_coord);
    966         xfree((void**)&third_gauss_area_coord);
    967         xfree((void**)&gauss_weights);
    968 
    969 }       
    970 /*}}}*/
    971 /*FUNCTION CreateKMatrixSlopeCompute {{{1*/
    972 #undef __FUNCT__
    973 #define __FUNCT__ "Tria::CreateKMatrixSlopeCompute"
    974 
    975 void  Tria::CreateKMatrixSlopeCompute(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
    976 
    977         /* local declarations */
    978         int             i,j;
    979 
    980         /* node data: */
    981         const int    numgrids=3;
    982         const int    NDOF1=1;
    983         const int    numdof=NDOF1*numgrids;
    984         double       xyz_list[numgrids][3];
    985         int          doflist[numdof];
    986         int          numberofdofspernode;
    987        
    988         /* gaussian points: */
    989         int     num_gauss,ig;
    990         double* first_gauss_area_coord  =  NULL;
    991         double* second_gauss_area_coord =  NULL;
    992         double* third_gauss_area_coord  =  NULL;
    993         double* gauss_weights           =  NULL;
    994         double  gauss_weight;
    995         double  gauss_l1l2l3[3];
    996 
    997         /* matrices: */
    998         double L[1][3];
    999         double DL_scalar;
    1000 
    1001         /* local element matrices: */
    1002         double Ke_gg[numdof][numdof]; //local element stiffness matrix
    1003         double Ke_gg_gaussian[numdof][numdof]; //stiffness matrix evaluated at the gaussian point.
    1004        
    1005         double Jdet;
    1006        
    1007         /* Get node coordinates and dof list: */
    1008         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    1009         GetDofList(&doflist[0],&numberofdofspernode);
    1010 
    1011         /* Set Ke_gg to 0: */
    1012         for(i=0;i<numdof;i++) for(j=0;j<numdof;j++) Ke_gg[i][j]=0.0;
    1013 
    1014         /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
    1015         GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
    1016 
    1017         /* Start  looping on the number of gaussian points: */
    1018         for (ig=0; ig<num_gauss; ig++){
    1019                 /*Pick up the gaussian point: */
    1020                 gauss_weight=*(gauss_weights+ig);
    1021                 gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
    1022                 gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
    1023                 gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
    1024 
    1025                
    1026                 /*Get L matrix: */
    1027                 GetL(&L[0][0], &xyz_list[0][0], gauss_l1l2l3,NDOF1);
    1028 
    1029                 /* Get Jacobian determinant: */
    1030                 GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
    1031                
    1032                 DL_scalar=gauss_weight*Jdet;
    1033 
    1034                 /*  Do the triple producte tL*D*L: */
    1035                 TripleMultiply( &L[0][0],1,3,1,
    1036                                         &DL_scalar,1,1,0,
    1037                                         &L[0][0],1,3,0,
    1038                                         &Ke_gg_gaussian[0][0],0);
    1039 
    1040                 /* Add the Ke_gg_gaussian, and optionally Ke_gg_drag_gaussian onto Ke_gg: */
    1041                 for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_gaussian[i][j];
    1042         } //for (ig=0; ig<num_gauss; ig++
    1043 
    1044         /*Add Ke_gg to global matrix Kgg: */
    1045         MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)Ke_gg,ADD_VALUES);
    1046                
    1047         cleanup_and_return:
    1048         xfree((void**)&first_gauss_area_coord);
    1049         xfree((void**)&second_gauss_area_coord);
    1050         xfree((void**)&third_gauss_area_coord);
    1051         xfree((void**)&gauss_weights);
    1052 }
    1053 /*}}}*/
    1054 /*FUNCTION CreatePVector {{{1*/
    1055 #undef __FUNCT__
    1056 #define __FUNCT__ "Tria::CreatePVector"
    1057 void  Tria::CreatePVector(Vec pg,void* inputs,int analysis_type,int sub_analysis_type){
    1058        
    1059         /*Just branch to the correct load generator, according to the type of analysis we are carrying out: */
    1060         if (analysis_type==ControlAnalysisEnum()){
    1061                
    1062                 CreatePVectorDiagnosticHoriz( pg,inputs,analysis_type,sub_analysis_type);
    1063        
    1064         }
    1065         else if (analysis_type==DiagnosticAnalysisEnum()){
    1066                 if (sub_analysis_type==HorizAnalysisEnum()){
    1067                
    1068                         CreatePVectorDiagnosticHoriz( pg,inputs,analysis_type,sub_analysis_type);
    1069                
    1070                 }
    1071                 else throw ErrorException(__FUNCT__,exprintf("%s%i%s\n","sub_analysis: ",sub_analysis_type," not supported yet"));
    1072         }
    1073         else if (analysis_type==SlopeComputeAnalysisEnum()){
    1074                
    1075                 CreatePVectorSlopeCompute( pg,inputs,analysis_type,sub_analysis_type);
    1076         }
    1077         else if (analysis_type==PrognosticAnalysisEnum()){
    1078 
    1079                 CreatePVectorPrognostic( pg,inputs,analysis_type,sub_analysis_type);
    1080         }
    1081         else{
    1082                 throw ErrorException(__FUNCT__,exprintf("%s%i%s"," analysis ",analysis_type," not supported yet"));
    1083         }
    1084 
    1085 }
    1086 /*}}}*/
    1087 /*FUNCTION CreatePVectorDiagnosticHoriz {{{1*/
    1088 #undef __FUNCT__
    1089 #define __FUNCT__ "Tria::CreatePVectorDiagnosticHoriz"
    1090 void Tria::CreatePVectorDiagnosticHoriz( Vec pg, void* vinputs, int analysis_type,int sub_analysis_type){
    1091 
    1092         int             i,j;
    1093 
    1094         /* node data: */
    1095         const int    numgrids=3;
    1096         const int    numdof=2*numgrids;
    1097         const int    NDOF2=2;
    1098         double       xyz_list[numgrids][3];
    1099         int          doflist[numdof];
    1100         int          numberofdofspernode;
    1101        
    1102         /* parameters: */
    1103         double  plastic_stress;
    1104         double  slope[NDOF2];
    1105         double  driving_stress_baseline;
    1106 
    1107         /* gaussian points: */
    1108         int     num_gauss,ig;
    1109         double* first_gauss_area_coord  =  NULL;
    1110         double* second_gauss_area_coord =  NULL;
    1111         double* third_gauss_area_coord  =  NULL;
    1112         double* gauss_weights           =  NULL;
    1113         double  gauss_weight;
    1114         double  gauss_l1l2l3[3];
    1115 
    1116         /* Jacobian: */
    1117         double Jdet;
    1118 
    1119         /*nodal functions: */
    1120         double l1l2l3[3];
    1121 
    1122         /*element vector at the gaussian points: */
    1123         double  pe_g[numdof];
    1124         double  pe_g_gaussian[numdof];
    1125 
    1126         /*input parameters for structural analysis (diagnostic): */
    1127         double  thickness;
    1128 
    1129         ParameterInputs* inputs=NULL;
    1130 
    1131         /*First, if we are on water, return empty vector: */
    1132         if(onwater)return;
    1133 
    1134         /*recover pointers: */
    1135         inputs=(ParameterInputs*)vinputs;
    1136 
    1137         /* Get node coordinates and dof list: */
    1138         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    1139         GetDofList(&doflist[0],&numberofdofspernode);
    1140 
    1141         /* Set pe_g to 0: */
    1142         for(i=0;i<numdof;i++) pe_g[i]=0.0;
    1143 
    1144 
    1145         #ifdef _DEBUGELEMENTS_
    1146         if(my_rank==RANK && id==ELID){
    1147                 printf("gravity %g\n",matpar->GetG());
    1148                 printf("rho_ice %g\n",matpar->GetRhoIce());
    1149                 printf("thickness [%g,%g,%g]\n",h[0],h[1],h[2]);
    1150                 printf("surface[%g,%g,%g]\n",s[0],s[1],s[2]);
    1151                 printf("bed[%g,%g,%g]\n",b[0],b[1],b[2]);
    1152                 printf("drag [%g,%g,%g]\n",k[0],k[1],k[2]);
    1153         }
    1154         #endif
    1155 
    1156 
    1157         /* Get gaussian points and weights: */
    1158         GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2); /*We need higher order because our load is order 2*/
    1159 
    1160         #ifdef _DEBUGELEMENTS_
    1161         if(my_rank==RANK && id==ELID){
    1162                 printf("   gaussian points: \n");
    1163                 for(i=0;i<num_gauss;i++){
    1164                         printf("    %g %g %g : %g\n",first_gauss_area_coord[i],second_gauss_area_coord[i],third_gauss_area_coord[i],gauss_weights[i]);
    1165                 }
    1166         }
    1167         #endif
    1168 
    1169 
    1170 
    1171         /* Start  looping on the number of gaussian points: */
    1172         for (ig=0; ig<num_gauss; ig++){
    1173                 /*Pick up the gaussian point: */
    1174                 gauss_weight=*(gauss_weights+ig);
    1175                 gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
    1176                 gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
    1177                 gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
    1178 
    1179                 /*Compute thickness at gaussian point: */
    1180                 GetParameterValue(&thickness, &h[0],gauss_l1l2l3);
    1181        
    1182                 GetParameterDerivativeValue(&slope[0], &s[0],&xyz_list[0][0], gauss_l1l2l3);
    1183                
    1184                 /*In case we have plastic basal drag, compute plastic stress at gaussian point from k1, k2 and k3 fields in the
    1185                  * element itself: */
    1186                 if(friction_type==1){
    1187                         GetParameterValue(&plastic_stress, &k[0],gauss_l1l2l3);
    1188                 }
    1189 
    1190                 /* Get Jacobian determinant: */
    1191                 GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
    1192                
    1193                  /*Get nodal functions: */
    1194                 GetNodalFunctions(l1l2l3, gauss_l1l2l3);
    1195 
    1196                 /*Compute driving stress: */
    1197                 driving_stress_baseline=matpar->GetRhoIce()*matpar->GetG()*thickness;
    1198 
    1199 
    1200                 #ifdef _DEBUGELEMENTS_
    1201                 if(my_rank==RANK && id==ELID){
    1202                         printf("      gaussian %i\n",ig);
    1203                         printf("      thickness %g\n",thickness);
    1204                         printf("      slope(%g,%g)\n",slope[0],slope[1]);
    1205                         printf("      Jdet %g\n",Jdet);
    1206                         printf("      gaussweigth %g\n",gauss_weight);
    1207                         printf("      l1l2l3 (%g,%g,%g)\n",l1l2l3[0],l1l2l3[1],l1l2l3[2]);
    1208                         if(friction_type==1)printf("      plastic_stress(%g)\n",plastic_stress);
    1209                 }
    1210                 #endif
    1211 
    1212                 /*Build pe_g_gaussian vector: */
    1213                 if(friction_type==1){
    1214                         for (i=0;i<numgrids;i++){
    1215                                 for (j=0;j<NDOF2;j++){
    1216                                         pe_g_gaussian[i*NDOF2+j]=(-driving_stress_baseline*slope[j]-plastic_stress)*Jdet*gauss_weight*l1l2l3[i];
    1217                                 }
    1218                         }
    1219                 }
    1220                 else {
    1221                         for (i=0;i<numgrids;i++){
    1222                                 for (j=0;j<NDOF2;j++){
    1223                                         pe_g_gaussian[i*NDOF2+j]=-driving_stress_baseline*slope[j]*Jdet*gauss_weight*l1l2l3[i];
    1224                                 }
    1225                         }
    1226                 }
    1227 
    1228                 /*Add pe_g_gaussian vector to pe_g: */
    1229                 for( i=0; i<numdof; i++)pe_g[i]+=pe_g_gaussian[i];
    1230 
    1231         } //for (ig=0; ig<num_gauss; ig++)
    1232 
    1233         #ifdef _DEBUGELEMENTS_
    1234         if(my_rank==RANK && id==ELID){
    1235                 printf("      pe_g->terms\n",ig);
    1236                 for( i=0; i<pe_g->nrows; i++){
    1237                         printf("%g ",*(pe_g->terms+i));
    1238                 }
    1239                 printf("\n");
    1240                 printf("      pe_g->row_indices\n",ig);
    1241                 for( i=0; i<pe_g->nrows; i++){
    1242                         printf("%i ",*(pe_g->row_indices+i));
    1243                 }
    1244         }
    1245         #endif
    1246 
    1247         /*Add pe_g to global vector pg: */
    1248         VecSetValues(pg,numdof,doflist,(const double*)pe_g,ADD_VALUES);
    1249 
    1250         cleanup_and_return:
    1251         xfree((void**)&first_gauss_area_coord);
    1252         xfree((void**)&second_gauss_area_coord);
    1253         xfree((void**)&third_gauss_area_coord);
    1254         xfree((void**)&gauss_weights);
    1255 
    1256 }
    1257 /*}}}*/
    1258 /*FUNCTION CreatePVectorPrognostic {{{1*/
    1259 #undef __FUNCT__
    1260 #define __FUNCT__ "Tria::CreatePVectorPrognostic"
    1261 void  Tria::CreatePVectorPrognostic(Vec pg ,void* vinputs,int analysis_type,int sub_analysis_type){
    1262 
    1263 
    1264         /* local declarations */
    1265         int             i,j;
    1266 
    1267         /* node data: */
    1268         const int    numgrids=3;
    1269         const int    NDOF1=1;
    1270         const int    numdof=NDOF1*numgrids;
    1271         double       xyz_list[numgrids][3];
    1272         int          doflist[numdof];
    1273         int          numberofdofspernode;
    1274 
    1275         /* gaussian points: */
    1276         int     num_gauss,ig;
    1277         double* first_gauss_area_coord  =  NULL;
    1278         double* second_gauss_area_coord =  NULL;
    1279         double* third_gauss_area_coord  =  NULL;
    1280         double* gauss_weights           =  NULL;
    1281         double  gauss_weight;
    1282         double  gauss_l1l2l3[3];
    1283 
    1284         /* matrix */
    1285         double pe_g[numgrids]={0.0};
    1286         double L[numgrids];
    1287         double Jdettria;
    1288 
    1289         /*input parameters for structural analysis (diagnostic): */
    1290         double  accumulation_list[numgrids]={0.0};
    1291         double  accumulation_g;
    1292         double  melting_list[numgrids]={0.0};
    1293         double  melting_g;
    1294         double  thickness_list[numgrids]={0.0};
    1295         double  thickness_g;
    1296         double  dt;
    1297         int     dofs[1]={0};
    1298         int     found=0;
    1299 
    1300         ParameterInputs* inputs=NULL;
    1301 
    1302         /*recover pointers: */
    1303         inputs=(ParameterInputs*)vinputs;
    1304 
    1305         /*recover extra inputs from users, at current convergence iteration: */
    1306         found=inputs->Recover("accumulation",&accumulation_list[0],1,dofs,numgrids,(void**)nodes);
    1307         if(!found)throw ErrorException(__FUNCT__," could not find accumulation in inputs!");
    1308         found=inputs->Recover("melting",&melting_list[0],1,dofs,numgrids,(void**)nodes);
    1309         if(!found)throw ErrorException(__FUNCT__," could not find melting in inputs!");
    1310         found=inputs->Recover("thickness",&thickness_list[0],1,dofs,numgrids,(void**)nodes);
    1311         if(!found)throw ErrorException(__FUNCT__," could not find thickness in inputs!");
    1312         found=inputs->Recover("dt",&dt);
    1313         if(!found)throw ErrorException(__FUNCT__," could not find dt in inputs!");
    1314 
    1315         /* Get node coordinates and dof list: */
    1316         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    1317         GetDofList(&doflist[0],&numberofdofspernode);
    1318 
    1319         /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
    1320         GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
    1321 
    1322         /* Start  looping on the number of gaussian points: */
    1323         for (ig=0; ig<num_gauss; ig++){
    1324                 /*Pick up the gaussian point: */
    1325                 gauss_weight=*(gauss_weights+ig);
    1326                 gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
    1327                 gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
    1328                 gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
    1329 
    1330                 /* Get Jacobian determinant: */
    1331                 GetJacobianDeterminant2d(&Jdettria, &xyz_list[0][0],gauss_l1l2l3);
    1332 
    1333                 /*Get L matrix: */
    1334                 GetL(&L[0], &xyz_list[0][0], gauss_l1l2l3,numberofdofspernode);
    1335 
    1336                 /* Get accumulation, melting and thickness at gauss point */
    1337                 GetParameterValue(&accumulation_g, &accumulation_list[0],gauss_l1l2l3);
    1338                 GetParameterValue(&melting_g, &melting_list[0],gauss_l1l2l3);
    1339                 GetParameterValue(&thickness_g, &thickness_list[0],gauss_l1l2l3);
    1340 
    1341                 /* Add value into pe_g: */
    1342                 for( i=0; i<numdof; i++) pe_g[i]+=Jdettria*gauss_weight*(thickness_g+dt*(accumulation_g-melting_g))*L[i];
    1343 
    1344         } // for (ig=0; ig<num_gauss; ig++)
    1345 
    1346         /*Add pe_g to global matrix Kgg: */
    1347         VecSetValues(pg,numdof,doflist,(const double*)pe_g,ADD_VALUES);
    1348 
    1349 cleanup_and_return:
    1350         xfree((void**)&first_gauss_area_coord);
    1351         xfree((void**)&second_gauss_area_coord);
    1352         xfree((void**)&third_gauss_area_coord);
    1353         xfree((void**)&gauss_weights);
    1354 
    1355 }
    1356 /*}}}*/
    1357 /*FUNCTION CreatePVectorSlopeCompute {{{1*/
    1358 #undef __FUNCT__
    1359 #define __FUNCT__ "Tria::CreatePVectorSlopeCompute"
    1360 
    1361 void Tria::CreatePVectorSlopeCompute( Vec pg, void* vinputs, int analysis_type,int sub_analysis_type){
    1362 
    1363         int             i,j;
    1364 
    1365         /* node data: */
    1366         const int    numgrids=3;
    1367         const int    NDOF1=1;
    1368         const int    numdof=NDOF1*numgrids;
    1369         double       xyz_list[numgrids][3];
    1370         int          doflist[numdof];
    1371         int          numberofdofspernode;
    1372        
    1373         /* gaussian points: */
    1374         int     num_gauss,ig;
    1375         double* first_gauss_area_coord  =  NULL;
    1376         double* second_gauss_area_coord =  NULL;
    1377         double* third_gauss_area_coord  =  NULL;
    1378         double* gauss_weights           =  NULL;
    1379         double  gauss_weight;
    1380         double  gauss_l1l2l3[3];
    1381 
    1382         /* Jacobian: */
    1383         double Jdet;
    1384 
    1385         /*nodal functions: */
    1386         double l1l2l3[3];
    1387 
    1388         /*element vector at the gaussian points: */
    1389         double  pe_g[numdof];
    1390         double  pe_g_gaussian[numdof];
    1391         double  param[3];
    1392         double  slope[2];
    1393 
    1394         /* Get node coordinates and dof list: */
    1395         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    1396         GetDofList(&doflist[0],&numberofdofspernode);
    1397 
    1398         /* Set pe_g to 0: */
    1399         for(i=0;i<numdof;i++) pe_g[i]=0.0;
    1400 
    1401         if ( (sub_analysis_type==SurfaceXAnalysisEnum()) || (sub_analysis_type==SurfaceYAnalysisEnum())){
    1402                 for(i=0;i<numdof;i++) param[i]=s[i];
    1403         }
    1404         if ( (sub_analysis_type==BedXAnalysisEnum()) || (sub_analysis_type==BedYAnalysisEnum())){
    1405                 for(i=0;i<numdof;i++) param[i]=b[i];
    1406         }
    1407 
    1408         /* Get gaussian points and weights: */
    1409         GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2); /*We need higher order because our load is order 2*/
    1410 
    1411 
    1412         /* Start  looping on the number of gaussian points: */
    1413         for (ig=0; ig<num_gauss; ig++){
    1414                 /*Pick up the gaussian point: */
    1415                 gauss_weight=*(gauss_weights+ig);
    1416                 gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
    1417                 gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
    1418                 gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
    1419 
    1420                 GetParameterDerivativeValue(&slope[0], &param[0],&xyz_list[0][0], gauss_l1l2l3);
    1421                
    1422                 /* Get Jacobian determinant: */
    1423                 GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
    1424                
    1425                  /*Get nodal functions: */
    1426                 GetNodalFunctions(l1l2l3, gauss_l1l2l3);
    1427 
    1428                 /*Build pe_g_gaussian vector: */
    1429                 if ( (sub_analysis_type==SurfaceXAnalysisEnum()) || (sub_analysis_type==BedXAnalysisEnum())){
    1430                         for(i=0;i<numdof;i++) pe_g_gaussian[i]=Jdet*gauss_weight*slope[0]*l1l2l3[i];
    1431                 }
    1432                 if ( (sub_analysis_type==SurfaceYAnalysisEnum()) || (sub_analysis_type==BedYAnalysisEnum())){
    1433                         for(i=0;i<numdof;i++) pe_g_gaussian[i]=Jdet*gauss_weight*slope[1]*l1l2l3[i];
    1434                 }
    1435 
    1436                 /*Add pe_g_gaussian vector to pe_g: */
    1437                 for( i=0; i<numdof; i++)pe_g[i]+=pe_g_gaussian[i];
    1438 
    1439         } //for (ig=0; ig<num_gauss; ig++)
    1440 
    1441         /*Add pe_g to global vector pg: */
    1442         VecSetValues(pg,numdof,doflist,(const double*)pe_g,ADD_VALUES);
    1443 
    1444         cleanup_and_return:
    1445         xfree((void**)&first_gauss_area_coord);
    1446         xfree((void**)&second_gauss_area_coord);
    1447         xfree((void**)&third_gauss_area_coord);
    1448         xfree((void**)&gauss_weights);
    1449 
    1450 }
    1451 /*}}}*/
    1452 /*FUNCTION UpdateFromInputs {{{1*/
    1453 #undef __FUNCT__
    1454 #define __FUNCT__ "Tria::UpdateFromInputs"
    1455 void  Tria::UpdateFromInputs(void* vinputs){
    1456 
    1457         int     dofs[1]={0};
    1458         double  temperature_list[3];
    1459         double  temperature_average;
    1460         double  B_list[3];
    1461         double  B_average;
    1462 
    1463         ParameterInputs* inputs=NULL;
    1464 
    1465         /*recover pointers: */
    1466         inputs=(ParameterInputs*)vinputs;
    1467 
    1468         /*Update internal data if inputs holds new values: */
    1469         inputs->Recover("thickness",&h[0],1,dofs,3,(void**)nodes);
    1470         inputs->Recover("surface",&s[0],1,dofs,3,(void**)nodes);
    1471         inputs->Recover("bed",&b[0],1,dofs,3,(void**)nodes);
    1472         inputs->Recover("drag",&k[0],1,dofs,3,(void**)nodes);
    1473         inputs->Recover("melting",&melting[0],1,dofs,3,(void**)nodes);
    1474         inputs->Recover("accumulation",&accumulation[0],1,dofs,3,(void**)nodes);
    1475         inputs->Recover("geothermalflux",&geothermalflux[0],1,dofs,3,(void**)nodes);
    1476        
    1477         //Update material if necessary
    1478         if(inputs->Recover("temperature_average",&temperature_list[0],1,dofs,3,(void**)nodes)){
    1479                 temperature_average=(temperature_list[0]+temperature_list[1]+temperature_list[2])/3.0;
    1480                 B_average=Paterson(temperature_average);
    1481                 matice->SetB(B_average);
    1482         }
    1483        
    1484         if(inputs->Recover("B",&B_list[0],1,dofs,3,(void**)nodes)){
    1485                 B_average=(B_list[0]+B_list[1]+B_list[2])/3.0;
    1486                 matice->SetB(B_average);
    1487         }
    1488 
     2465        /*Build B: */
     2466        for (i=0;i<numgrids;i++){
     2467                *(B+NDOF2*numgrids*0+NDOF2*i)=dh1dh2dh3_basic[0][i]; //B[0][NDOF2*i]=dh1dh2dh3_basic[0][i];
     2468                *(B+NDOF2*numgrids*0+NDOF2*i+1)=0;
     2469                *(B+NDOF2*numgrids*1+NDOF2*i)=0;
     2470                *(B+NDOF2*numgrids*1+NDOF2*i+1)=dh1dh2dh3_basic[1][i];
     2471                *(B+NDOF2*numgrids*2+NDOF2*i)=(float).5*dh1dh2dh3_basic[1][i];
     2472                *(B+NDOF2*numgrids*2+NDOF2*i+1)=(float).5*dh1dh2dh3_basic[0][i];
     2473        }
     2474}
     2475/*}}}*/
     2476/*FUNCTION GetB_prog {{{1*/
     2477#undef __FUNCT__
     2478#define __FUNCT__ "Tria::GetB_prog"
     2479
     2480void Tria::GetB_prog(double* B_prog, double* xyz_list, double* gauss_l1l2l3){
     2481
     2482        /*Compute B  matrix. B=[B1 B2 B3] where Bi is of size 3*NDOF2.
     2483         * For grid i, Bi can be expressed in the basic coordinate system
     2484         * by:
     2485         *       Bi_basic=[ h ]
     2486         *                [ h ]
     2487         * where h is the interpolation function for grid i.
     2488         *
     2489         * We assume B_prog has been allocated already, of size: 2x(NDOF1*numgrids)
     2490         */
     2491
     2492        int i;
     2493        const int NDOF1=1;
     2494        const int numgrids=3;
     2495
     2496        double l1l2l3[numgrids];
     2497
     2498
     2499        /*Get dh1dh2dh3 in basic coordinate system: */
     2500        GetNodalFunctions(&l1l2l3[0],gauss_l1l2l3);
     2501
     2502#ifdef _ISSM_DEBUG_
     2503        for (i=0;i<3;i++){
     2504                printf("Node %i  h=%lf \n",i,l1l2l3[i]);
     2505        }
     2506#endif
     2507
     2508        /*Build B_prog: */
     2509        for (i=0;i<numgrids;i++){
     2510                *(B_prog+NDOF1*numgrids*0+NDOF1*i)=l1l2l3[i];
     2511                *(B_prog+NDOF1*numgrids*1+NDOF1*i)=l1l2l3[i];
     2512        }
     2513}
     2514/*}}}*/
     2515/*FUNCTION GetBedList {{{1*/
     2516void  Tria::GetBedList(double* bed_list){
     2517
     2518        int i;
     2519        for(i=0;i<3;i++)bed_list[i]=b[i];
     2520
     2521}
     2522/*}}}*/
     2523/*FUNCTION GetBPrime {{{1*/
     2524#undef __FUNCT__
     2525#define __FUNCT__ "Tria::GetBPrime"
     2526
     2527void Tria::GetBPrime(double* Bprime, double* xyz_list, double* gauss_l1l2l3){
     2528
     2529        /*Compute B'  matrix. B'=[B1' B2' B3'] where Bi' is of size 3*NDOF2.
     2530         * For grid i, Bi' can be expressed in the basic coordinate system
     2531         * by:
     2532         *       Bi_prime__basic=[ 2*dh/dx dh/dy ]
     2533         *                       [ dh/dx  2*dh/dy]
     2534         *                       [dh/dy dh/dx]
     2535         * where h is the interpolation function for grid i.
     2536         *
     2537         * We assume B' has been allocated already, of size: 3x(NDOF2*numgrids)
     2538         */
     2539       
     2540        int i;
     2541        const int NDOF2=2;
     2542        const int numgrids=3;
     2543
     2544        /*Same thing in the basic coordinate system: */
     2545        double dh1dh2dh3_basic[NDOF2][numgrids];
     2546
     2547
     2548        /*Get dh1dh2dh3 in basic coordinates system : */
     2549        GetNodalFunctionsDerivativesBasic(&dh1dh2dh3_basic[0][0],xyz_list,gauss_l1l2l3);
     2550
     2551        /*Build B': */
     2552        for (i=0;i<numgrids;i++){
     2553                *(Bprime+NDOF2*numgrids*0+NDOF2*i)=2*dh1dh2dh3_basic[0][i];
     2554                *(Bprime+NDOF2*numgrids*0+NDOF2*i+1)=dh1dh2dh3_basic[1][i];
     2555                *(Bprime+NDOF2*numgrids*1+NDOF2*i)=dh1dh2dh3_basic[0][i];
     2556                *(Bprime+NDOF2*numgrids*1+NDOF2*i+1)=2*dh1dh2dh3_basic[1][i];
     2557                *(Bprime+NDOF2*numgrids*2+NDOF2*i)=dh1dh2dh3_basic[1][i];
     2558                *(Bprime+NDOF2*numgrids*2+NDOF2*i+1)=dh1dh2dh3_basic[0][i];
     2559        }
     2560}
     2561/*}}}*/
     2562/*FUNCTION GetBPrime_prog {{{1*/
     2563#undef __FUNCT__
     2564#define __FUNCT__ "Tria::GetBPrime_prog"
     2565
     2566void Tria::GetBPrime_prog(double* Bprime_prog, double* xyz_list, double* gauss_l1l2l3){
     2567
     2568        /*Compute B'  matrix. B'=[B1' B2' B3'] where Bi' is of size 3*NDOF2.
     2569         * For grid i, Bi' can be expressed in the basic coordinate system
     2570         * by:
     2571         *       Bi_prime__basic=[ dh/dx ]
     2572         *                       [ dh/dy ]
     2573         * where h is the interpolation function for grid i.
     2574         *
     2575         * We assume B' has been allocated already, of size: 3x(NDOF2*numgrids)
     2576         */
     2577
     2578        int i;
     2579        const int NDOF1=1;
     2580        const int NDOF2=2;
     2581        const int numgrids=3;
     2582
     2583        /*Same thing in the basic coordinate system: */
     2584        double dh1dh2dh3_basic[NDOF2][numgrids];
     2585
     2586        /*Get dh1dh2dh3 in basic coordinates system : */
     2587        GetNodalFunctionsDerivativesBasic(&dh1dh2dh3_basic[0][0],xyz_list,gauss_l1l2l3);
     2588
     2589        /*Build B': */
     2590        for (i=0;i<numgrids;i++){
     2591                *(Bprime_prog+NDOF1*numgrids*0+NDOF1*i)=dh1dh2dh3_basic[0][i];
     2592                *(Bprime_prog+NDOF1*numgrids*1+NDOF1*i)=dh1dh2dh3_basic[1][i];
     2593        }
    14892594}
    14902595/*}}}*/
    … …  
    15182623}
    15192624/*}}}*/
    1520 /*FUNCTION GetParameterValue {{{1*/
    1521 #undef __FUNCT__
    1522 #define __FUNCT__ "Tria::GetParameterValue"
    1523 void Tria::GetParameterValue(double* pp, double* plist, double* gauss_l1l2l3){
    1524        
    1525         /*From node values of parameter p (plist[0],plist[1],plist[2]), return parameter value at gaussian
    1526          * point specifie by gauss_l1l2l3: */
    1527        
    1528         /*nodal functions: */
     2625/*FUNCTION GetId {{{1*/
     2626int    Tria::GetId(){ return id; }
     2627/*}}}*/
     2628/*FUNCTION GetJacobian {{{1*/
     2629#undef __FUNCT__
     2630#define __FUNCT__ "Tria::GetJacobian"
     2631void Tria::GetJacobian(double* J, double* xyz_list,double* gauss_l1l2l3){
     2632
     2633        /*The Jacobian is constant over the element, discard the gaussian points.
     2634         * J is assumed to have been allocated of size NDOF2xNDOF2.*/
     2635
     2636        const int NDOF2=2;
     2637        const int numgrids=3;
     2638        double x1,y1,x2,y2,x3,y3;
     2639        double sqrt3=sqrt(3.0);
     2640       
     2641        x1=*(xyz_list+numgrids*0+0);
     2642        y1=*(xyz_list+numgrids*0+1);
     2643        x2=*(xyz_list+numgrids*1+0);
     2644        y2=*(xyz_list+numgrids*1+1);
     2645        x3=*(xyz_list+numgrids*2+0);
     2646        y3=*(xyz_list+numgrids*2+1);
     2647
     2648
     2649        *(J+NDOF2*0+0)=1.0/2.0*(x2-x1);
     2650        *(J+NDOF2*1+0)=sqrt3/6.0*(2*x3-x1-x2);
     2651        *(J+NDOF2*0+1)=1.0/2.0*(y2-y1);
     2652        *(J+NDOF2*1+1)=sqrt3/6.0*(2*y3-y1-y2);
     2653}
     2654/*}}}*/
     2655/*FUNCTION GetJacobianDeterminant2d {{{1*/
     2656#undef __FUNCT__
     2657#define __FUNCT__ "Tria::GetJacobianDeterminant2d"
     2658void Tria::GetJacobianDeterminant2d(double*  Jdet, double* xyz_list,double* gauss_l1l2l3){
     2659
     2660        /*The Jacobian determinant is constant over the element, discard the gaussian points.
     2661         * J is assumed to have been allocated of size NDOF2xNDOF2.*/
     2662
     2663        double x1,x2,x3,y1,y2,y3;
     2664       
     2665        x1=*(xyz_list+3*0+0);
     2666        y1=*(xyz_list+3*0+1);
     2667        x2=*(xyz_list+3*1+0);
     2668        y2=*(xyz_list+3*1+1);
     2669        x3=*(xyz_list+3*2+0);
     2670        y3=*(xyz_list+3*2+1);
     2671
     2672
     2673        *Jdet=sqrt(3.0)/6.0*((x2-x1)*(y3-y1)-(y2-y1)*(x3-x1));
     2674
     2675
     2676        if(Jdet<0){
     2677                printf("%s%s\n",__FUNCT__," error message: negative jacobian determinant!");
     2678        }
     2679       
     2680}
     2681/*}}}*/
     2682/*FUNCTION GetJacobianDeterminant3d {{{1*/
     2683#undef __FUNCT__
     2684#define __FUNCT__ "Tria::GetJacobianDeterminant3d"
     2685void Tria::GetJacobianDeterminant3d(double*  Jdet, double* xyz_list,double* gauss_l1l2l3){
     2686
     2687        /*The Jacobian determinant is constant over the element, discard the gaussian points.
     2688         * J is assumed to have been allocated of size NDOF2xNDOF2.*/
     2689
     2690        double x1,x2,x3,y1,y2,y3,z1,z2,z3;
     2691       
     2692        x1=*(xyz_list+3*0+0);
     2693        y1=*(xyz_list+3*0+1);
     2694        z1=*(xyz_list+3*0+2);
     2695        x2=*(xyz_list+3*1+0);
     2696        y2=*(xyz_list+3*1+1);
     2697        z2=*(xyz_list+3*1+2);
     2698        x3=*(xyz_list+3*2+0);
     2699        y3=*(xyz_list+3*2+1);
     2700        z3=*(xyz_list+3*2+2);
     2701
     2702
     2703        *Jdet=sqrt(3.0)/6.0*pow(pow(((y2-y1)*(z3-z1)-(z2-z1)*(y3-y1)),2.0)+pow(((z2-z1)*(x3-x1)-(x2-x1)*(z3-z1)),2.0)+pow(((x2-x1)*(y3-y1)-(y2-y1)*(x3-x1)),2.0),0.5);
     2704
     2705
     2706        if(Jdet<0){
     2707                printf("%s%s\n",__FUNCT__," error message: negative jacobian determinant!");
     2708        }
     2709       
     2710}
     2711/*}}}*/
     2712/*FUNCTION GetJacobianInvert {{{1*/
     2713#undef __FUNCT__
     2714#define __FUNCT__ "Tria::GetJacobianInvert"
     2715void Tria::GetJacobianInvert(double*  Jinv, double* xyz_list,double* gauss_l1l2l3){
     2716
     2717        double Jdet;
     2718        const int NDOF2=2;
     2719        const int numgrids=3;
     2720
     2721        /*Call Jacobian routine to get the jacobian:*/
     2722        GetJacobian(Jinv, xyz_list, gauss_l1l2l3);
     2723
     2724        /*Invert Jacobian matrix: */
     2725        MatrixInverse(Jinv,NDOF2,NDOF2,NULL,0,&Jdet);
     2726
     2727}
     2728/*}}}*/
     2729/*FUNCTION GetL {{{1*/
     2730#undef __FUNCT__
     2731#define __FUNCT__ "Tria::GetL"
     2732
     2733void Tria::GetL(double* L, double* xyz_list, double* gauss_l1l2l3,int numdof){
     2734
     2735        /*Compute L  matrix. L=[L1 L2 L3] where Li is square and of size numdof.
     2736         * For grid i, Li can be expressed in the basic coordinate system
     2737         * by:
     2738         *       numdof=1:
     2739         *       Li_basic=h;
     2740         *       numdof=2:
     2741         *       Li_basic=[ h    0    ]
     2742         *                [   0   h  ]
     2743         * where h is the interpolation function for grid i.
     2744         *
     2745         * We assume L has been allocated already, of size: numgrids (numdof=1), or numdofx(numdof*numgrids) (numdof=2)
     2746         */
     2747
     2748        int i;
     2749        const int NDOF2=2;
     2750        const int numgrids=3;
     2751
    15292752        double l1l2l3[3];
    15302753
    1531         /*output: */
    1532         double p;
    1533 
     2754
     2755        /*Get l1l2l3 in basic coordinate system: */
    15342756        GetNodalFunctions(l1l2l3, gauss_l1l2l3);
    15352757
    1536         p=l1l2l3[0]*plist[0]+l1l2l3[1]*plist[1]+l1l2l3[2]*plist[2];
    1537 
    1538         /*Assign output pointers:*/
    1539         *pp=p;
     2758#ifdef _DELUG_
     2759        for (i=0;i<3;i++){
     2760                printf("Node %i  h=%lf \n",i,l1l2l3[i]);
     2761        }
     2762#endif
     2763
     2764        /*Build L: */
     2765        if(numdof==1){
     2766                for (i=0;i<numgrids;i++){
     2767                        L[i]=l1l2l3[i];
     2768                }
     2769        }
     2770        else{
     2771                for (i=0;i<numgrids;i++){
     2772                        *(L+numdof*numgrids*0+numdof*i)=l1l2l3[i]; //L[0][NDOF2*i]=dh1dh2dh3_basic[0][i];
     2773                        *(L+numdof*numgrids*0+numdof*i+1)=0;
     2774                        *(L+numdof*numgrids*1+numdof*i)=0;
     2775                        *(L+numdof*numgrids*1+numdof*i+1)=l1l2l3[i];
     2776                }
     2777        }
     2778}
     2779/*}}}*/
     2780/*FUNCTION GetMatPar {{{1*/
     2781void* Tria::GetMatPar(){
     2782        return matpar;
     2783}
     2784/*}}}*/
     2785/*FUNCTION GetName {{{1*/
     2786char* Tria::GetName(void){
     2787        return "tria";
     2788}
     2789/*}}}*/
     2790/*FUNCTION GetNodalFunctions {{{1*/
     2791#undef __FUNCT__
     2792#define __FUNCT__ "Tria::GetNodalFunctions"
     2793void Tria::GetNodalFunctions(double* l1l2l3, double* gauss_l1l2l3){
     2794       
     2795        /*This routine returns the values of the nodal functions  at the gaussian point.*/
     2796
     2797        /*First nodal function: */
     2798        l1l2l3[0]=gauss_l1l2l3[0];
     2799
     2800        /*Second nodal function: */
     2801        l1l2l3[1]=gauss_l1l2l3[1];
     2802
     2803        /*Third nodal function: */
     2804        l1l2l3[2]=gauss_l1l2l3[2];
     2805
     2806}
     2807/*}}}*/
     2808/*FUNCTION GetNodalFunctionsDerivativesBasic {{{1*/
     2809#undef __FUNCT__
     2810#define __FUNCT__ "Tria::GetNodalFunctionsDerivativesBasic"
     2811void Tria::GetNodalFunctionsDerivativesBasic(double* dh1dh2dh3_basic,double* xyz_list, double* gauss_l1l2l3){
     2812       
     2813        /*This routine returns the values of the nodal functions derivatives  (with respect to the
     2814         * basic coordinate system: */
     2815
     2816        int i;
     2817        const int NDOF2=2;
     2818        const int numgrids=3;
     2819
     2820        double dh1dh2dh3_param[NDOF2][numgrids];
     2821        double Jinv[NDOF2][NDOF2];
     2822
     2823
     2824        /*Get derivative values with respect to parametric coordinate system: */
     2825        GetNodalFunctionsDerivativesParams(&dh1dh2dh3_param[0][0], gauss_l1l2l3);
     2826
     2827        /*Get Jacobian invert: */
     2828        GetJacobianInvert(&Jinv[0][0], xyz_list, gauss_l1l2l3);
     2829
     2830        /*Build dh1dh2dh3_basic:
     2831         *
     2832         * [dhi/dx]= Jinv*[dhi/dr]
     2833         * [dhi/dy]       [dhi/ds]
     2834         */
     2835
     2836        for (i=0;i<numgrids;i++){
     2837                *(dh1dh2dh3_basic+numgrids*0+i)=Jinv[0][0]*dh1dh2dh3_param[0][i]+Jinv[0][1]*dh1dh2dh3_param[1][i];
     2838                *(dh1dh2dh3_basic+numgrids*1+i)=Jinv[1][0]*dh1dh2dh3_param[0][i]+Jinv[1][1]*dh1dh2dh3_param[1][i];
     2839        }
     2840
     2841}
     2842/*}}}*/
     2843/*FUNCTION GetNodalFunctionsDerivativesParams {{{1*/
     2844#undef __FUNCT__
     2845#define __FUNCT__ "Tria::GetNodalFunctionsDerivativesParams"
     2846void Tria::GetNodalFunctionsDerivativesParams(double* dl1dl2dl3,double* gauss_l1l2l3){
     2847       
     2848        /*This routine returns the values of the nodal functions derivatives  (with respect to the
     2849         * natural coordinate system) at the gaussian point. */
     2850
     2851        const int NDOF2=2;
     2852        const int numgrids=3;
     2853
     2854        double sqrt3=sqrt(3.0);
     2855
     2856        /*First nodal function: */
     2857        *(dl1dl2dl3+numgrids*0+0)=-1.0/2.0;
     2858        *(dl1dl2dl3+numgrids*1+0)=-1.0/(2.0*sqrt3);
     2859
     2860        /*Second nodal function: */
     2861        *(dl1dl2dl3+numgrids*0+1)=1.0/2.0;
     2862        *(dl1dl2dl3+numgrids*1+1)=-1.0/(2.0*sqrt3);
     2863
     2864        /*Third nodal function: */
     2865        *(dl1dl2dl3+numgrids*0+2)=0;
     2866        *(dl1dl2dl3+numgrids*1+2)=1.0/sqrt3;
     2867
     2868}
     2869/*}}}*/
     2870/*FUNCTION GetNodes {{{1*/
     2871void  Tria::GetNodes(void** vpnodes){
     2872        int i;
     2873        Node** pnodes=(Node**)vpnodes;
     2874
     2875        for(i=0;i<3;i++){
     2876                pnodes[i]=nodes[i];
     2877        }
     2878}
     2879/*}}}*/
     2880/*FUNCTION GetOnBed {{{1*/
     2881int Tria::GetOnBed(){
     2882        return onbed;
    15402883}
    15412884/*}}}*/
    … …  
    15652908}
    15662909/*}}}*/
     2910/*FUNCTION GetParameterValue {{{1*/
     2911#undef __FUNCT__
     2912#define __FUNCT__ "Tria::GetParameterValue"
     2913void Tria::GetParameterValue(double* pp, double* plist, double* gauss_l1l2l3){
     2914       
     2915        /*From node values of parameter p (plist[0],plist[1],plist[2]), return parameter value at gaussian
     2916         * point specifie by gauss_l1l2l3: */
     2917       
     2918        /*nodal functions: */
     2919        double l1l2l3[3];
     2920
     2921        /*output: */
     2922        double p;
     2923
     2924        GetNodalFunctions(l1l2l3, gauss_l1l2l3);
     2925
     2926        p=l1l2l3[0]*plist[0]+l1l2l3[1]*plist[1]+l1l2l3[2]*plist[2];
     2927
     2928        /*Assign output pointers:*/
     2929        *pp=p;
     2930}
     2931/*}}}*/
     2932/*FUNCTION GetShelf {{{1*/
     2933int   Tria::GetShelf(){
     2934        return shelf;
     2935}
     2936/*}}}*/
    15672937/*FUNCTION GetStrainRate {{{1*/
    15682938#undef __FUNCT__
    … …  
    15862956}
    15872957/*}}}*/
    1588 /*FUNCTION GetJacobianDeterminant2d {{{1*/
    1589 #undef __FUNCT__
    1590 #define __FUNCT__ "Tria::GetJacobianDeterminant2d"
    1591 void Tria::GetJacobianDeterminant2d(double*  Jdet, double* xyz_list,double* gauss_l1l2l3){
    1592 
    1593         /*The Jacobian determinant is constant over the element, discard the gaussian points.
    1594          * J is assumed to have been allocated of size NDOF2xNDOF2.*/
    1595 
    1596         double x1,x2,x3,y1,y2,y3;
    1597        
    1598         x1=*(xyz_list+3*0+0);
    1599         y1=*(xyz_list+3*0+1);
    1600         x2=*(xyz_list+3*1+0);
    1601         y2=*(xyz_list+3*1+1);
    1602         x3=*(xyz_list+3*2+0);
    1603         y3=*(xyz_list+3*2+1);
    1604 
    1605 
    1606         *Jdet=sqrt(3.0)/6.0*((x2-x1)*(y3-y1)-(y2-y1)*(x3-x1));
    1607 
    1608 
    1609         if(Jdet<0){
    1610                 printf("%s%s\n",__FUNCT__," error message: negative jacobian determinant!");
    1611         }
    1612        
    1613 }
    1614 /*}}}*/
    1615 /*FUNCTION GetJacobianDeterminant3d {{{1*/
    1616 #undef __FUNCT__
    1617 #define __FUNCT__ "Tria::GetJacobianDeterminant3d"
    1618 void Tria::GetJacobianDeterminant3d(double*  Jdet, double* xyz_list,double* gauss_l1l2l3){
    1619 
    1620         /*The Jacobian determinant is constant over the element, discard the gaussian points.
    1621          * J is assumed to have been allocated of size NDOF2xNDOF2.*/
    1622 
    1623         double x1,x2,x3,y1,y2,y3,z1,z2,z3;
    1624        
    1625         x1=*(xyz_list+3*0+0);
    1626         y1=*(xyz_list+3*0+1);
    1627         z1=*(xyz_list+3*0+2);
    1628         x2=*(xyz_list+3*1+0);
    1629         y2=*(xyz_list+3*1+1);
    1630         z2=*(xyz_list+3*1+2);
    1631         x3=*(xyz_list+3*2+0);
    1632         y3=*(xyz_list+3*2+1);
    1633         z3=*(xyz_list+3*2+2);
    1634 
    1635 
    1636         *Jdet=sqrt(3.0)/6.0*pow(pow(((y2-y1)*(z3-z1)-(z2-z1)*(y3-y1)),2.0)+pow(((z2-z1)*(x3-x1)-(x2-x1)*(z3-z1)),2.0)+pow(((x2-x1)*(y3-y1)-(y2-y1)*(x3-x1)),2.0),0.5);
    1637 
    1638 
    1639         if(Jdet<0){
    1640                 printf("%s%s\n",__FUNCT__," error message: negative jacobian determinant!");
    1641         }
    1642        
    1643 }
    1644 /*}}}*/
    1645 /*FUNCTION GetB {{{1*/
    1646 #undef __FUNCT__
    1647 #define __FUNCT__ "Tria::GetB"
    1648 
    1649 void Tria::GetB(double* B, double* xyz_list, double* gauss_l1l2l3){
    1650 
    1651         /*Compute B  matrix. B=[B1 B2 B3] where Bi is of size 3*NDOF2.
    1652          * For grid i, Bi can be expressed in the basic coordinate system
    1653          * by:
    1654          *       Bi_basic=[ dh/dx    0    ]
    1655          *                [   0    dh/dy  ]
    1656          *                [ 1/2*dh/dy  1/2*dh/dx  ]
    1657          * where h is the interpolation function for grid i.
    1658          *
    1659          * We assume B has been allocated already, of size: 3x(NDOF2*numgrids)
    1660          */
    1661        
    1662         int i;
    1663         const int NDOF2=2;
    1664         const int numgrids=3;
    1665 
    1666         double dh1dh2dh3_basic[NDOF2][numgrids];
    1667 
    1668 
    1669         /*Get dh1dh2dh3 in basic coordinate system: */
    1670         GetNodalFunctionsDerivativesBasic(&dh1dh2dh3_basic[0][0],xyz_list, gauss_l1l2l3);
    1671 
    1672         #ifdef _ISSM_DEBUG_
    1673         for (i=0;i<3;i++){
    1674                 printf("Node %i  dh/dx=%lf dh/dy=%lf \n",i,dh1dh2dh3_basic[0][i],dh1dh2dh3_basic[1][i]);
    1675         }
    1676         #endif
    1677 
    1678         /*Build B: */
    1679         for (i=0;i<numgrids;i++){
    1680                 *(B+NDOF2*numgrids*0+NDOF2*i)=dh1dh2dh3_basic[0][i]; //B[0][NDOF2*i]=dh1dh2dh3_basic[0][i];
    1681                 *(B+NDOF2*numgrids*0+NDOF2*i+1)=0;
    1682                 *(B+NDOF2*numgrids*1+NDOF2*i)=0;
    1683                 *(B+NDOF2*numgrids*1+NDOF2*i+1)=dh1dh2dh3_basic[1][i];
    1684                 *(B+NDOF2*numgrids*2+NDOF2*i)=(float).5*dh1dh2dh3_basic[1][i];
    1685                 *(B+NDOF2*numgrids*2+NDOF2*i+1)=(float).5*dh1dh2dh3_basic[0][i];
    1686         }
    1687 }
    1688 /*}}}*/
    1689 /*FUNCTION GetBPrime {{{1*/
    1690 #undef __FUNCT__
    1691 #define __FUNCT__ "Tria::GetBPrime"
    1692 
    1693 void Tria::GetBPrime(double* Bprime, double* xyz_list, double* gauss_l1l2l3){
    1694 
    1695         /*Compute B'  matrix. B'=[B1' B2' B3'] where Bi' is of size 3*NDOF2.
    1696          * For grid i, Bi' can be expressed in the basic coordinate system
    1697          * by:
    1698          *       Bi_prime__basic=[ 2*dh/dx dh/dy ]
    1699          *                       [ dh/dx  2*dh/dy]
    1700          *                       [dh/dy dh/dx]
    1701          * where h is the interpolation function for grid i.
    1702          *
    1703          * We assume B' has been allocated already, of size: 3x(NDOF2*numgrids)
    1704          */
    1705        
    1706         int i;
    1707         const int NDOF2=2;
    1708         const int numgrids=3;
    1709 
    1710         /*Same thing in the basic coordinate system: */
    1711         double dh1dh2dh3_basic[NDOF2][numgrids];
    1712 
    1713 
    1714         /*Get dh1dh2dh3 in basic coordinates system : */
    1715         GetNodalFunctionsDerivativesBasic(&dh1dh2dh3_basic[0][0],xyz_list,gauss_l1l2l3);
    1716 
    1717         /*Build B': */
    1718         for (i=0;i<numgrids;i++){
    1719                 *(Bprime+NDOF2*numgrids*0+NDOF2*i)=2*dh1dh2dh3_basic[0][i];
    1720                 *(Bprime+NDOF2*numgrids*0+NDOF2*i+1)=dh1dh2dh3_basic[1][i];
    1721                 *(Bprime+NDOF2*numgrids*1+NDOF2*i)=dh1dh2dh3_basic[0][i];
    1722                 *(Bprime+NDOF2*numgrids*1+NDOF2*i+1)=2*dh1dh2dh3_basic[1][i];
    1723                 *(Bprime+NDOF2*numgrids*2+NDOF2*i)=dh1dh2dh3_basic[1][i];
    1724                 *(Bprime+NDOF2*numgrids*2+NDOF2*i+1)=dh1dh2dh3_basic[0][i];
    1725         }
    1726 }
    1727 /*}}}*/
    1728 /*FUNCTION GetL {{{1*/
    1729 #undef __FUNCT__
    1730 #define __FUNCT__ "Tria::GetL"
    1731 
    1732 void Tria::GetL(double* L, double* xyz_list, double* gauss_l1l2l3,int numdof){
    1733 
    1734         /*Compute L  matrix. L=[L1 L2 L3] where Li is square and of size numdof.
    1735          * For grid i, Li can be expressed in the basic coordinate system
    1736          * by:
    1737          *       numdof=1:
    1738          *       Li_basic=h;
    1739          *       numdof=2:
    1740          *       Li_basic=[ h    0    ]
    1741          *                [   0   h  ]
    1742          * where h is the interpolation function for grid i.
    1743          *
    1744          * We assume L has been allocated already, of size: numgrids (numdof=1), or numdofx(numdof*numgrids) (numdof=2)
    1745          */
    1746        
    1747         int i;
    1748         const int NDOF2=2;
    1749         const int numgrids=3;
    1750 
    1751         double l1l2l3[3];
    1752 
    1753 
    1754         /*Get l1l2l3 in basic coordinate system: */
    1755         GetNodalFunctions(l1l2l3, gauss_l1l2l3);
    1756 
    1757         #ifdef _DELUG_
    1758         for (i=0;i<3;i++){
    1759                 printf("Node %i  h=%lf \n",i,l1l2l3[i]);
    1760         }
    1761         #endif
    1762 
    1763         /*Build L: */
    1764         if(numdof==1){
    1765                 for (i=0;i<numgrids;i++){
    1766                         L[i]=l1l2l3[i];
    1767                 }
    1768         }
    1769         else{
    1770                 for (i=0;i<numgrids;i++){
    1771                         *(L+numdof*numgrids*0+numdof*i)=l1l2l3[i]; //L[0][NDOF2*i]=dh1dh2dh3_basic[0][i];
    1772                         *(L+numdof*numgrids*0+numdof*i+1)=0;
    1773                         *(L+numdof*numgrids*1+numdof*i)=0;
    1774                         *(L+numdof*numgrids*1+numdof*i+1)=l1l2l3[i];
    1775                 }
    1776         }
    1777 }
    1778 /*}}}*/
    1779 /*FUNCTION GetB_prog {{{1*/
    1780 #undef __FUNCT__
    1781 #define __FUNCT__ "Tria::GetB_prog"
    1782 
    1783 void Tria::GetB_prog(double* B_prog, double* xyz_list, double* gauss_l1l2l3){
    1784 
    1785         /*Compute B  matrix. B=[B1 B2 B3] where Bi is of size 3*NDOF2.
    1786          * For grid i, Bi can be expressed in the basic coordinate system
    1787          * by:
    1788          *       Bi_basic=[ h ]
    1789          *                [ h ]
    1790          * where h is the interpolation function for grid i.
    1791          *
    1792          * We assume B_prog has been allocated already, of size: 2x(NDOF1*numgrids)
    1793          */
    1794        
    1795         int i;
    1796         const int NDOF1=1;
    1797         const int numgrids=3;
    1798 
    1799         double l1l2l3[numgrids];
    1800 
    1801 
    1802         /*Get dh1dh2dh3 in basic coordinate system: */
    1803         GetNodalFunctions(&l1l2l3[0],gauss_l1l2l3);
    1804 
    1805         #ifdef _ISSM_DEBUG_
    1806         for (i=0;i<3;i++){
    1807                 printf("Node %i  h=%lf \n",i,l1l2l3[i]);
    1808         }
    1809         #endif
    1810 
    1811         /*Build B_prog: */
    1812         for (i=0;i<numgrids;i++){
    1813                 *(B_prog+NDOF1*numgrids*0+NDOF1*i)=l1l2l3[i];
    1814                 *(B_prog+NDOF1*numgrids*1+NDOF1*i)=l1l2l3[i];
    1815         }
    1816 }
    1817 /*}}}*/
    1818 /*FUNCTION GetBPrime_prog {{{1*/
    1819 #undef __FUNCT__
    1820 #define __FUNCT__ "Tria::GetBPrime_prog"
    1821 
    1822 void Tria::GetBPrime_prog(double* Bprime_prog, double* xyz_list, double* gauss_l1l2l3){
    1823 
    1824         /*Compute B'  matrix. B'=[B1' B2' B3'] where Bi' is of size 3*NDOF2.
    1825          * For grid i, Bi' can be expressed in the basic coordinate system
    1826          * by:
    1827          *       Bi_prime__basic=[ dh/dx ]
    1828          *                       [ dh/dy ]
    1829          * where h is the interpolation function for grid i.
    1830          *
    1831          * We assume B' has been allocated already, of size: 3x(NDOF2*numgrids)
    1832          */
    1833        
    1834         int i;
    1835         const int NDOF1=1;
    1836         const int NDOF2=2;
    1837         const int numgrids=3;
    1838 
    1839         /*Same thing in the basic coordinate system: */
    1840         double dh1dh2dh3_basic[NDOF2][numgrids];
    1841 
    1842         /*Get dh1dh2dh3 in basic coordinates system : */
    1843         GetNodalFunctionsDerivativesBasic(&dh1dh2dh3_basic[0][0],xyz_list,gauss_l1l2l3);
    1844 
    1845         /*Build B': */
    1846         for (i=0;i<numgrids;i++){
    1847                 *(Bprime_prog+NDOF1*numgrids*0+NDOF1*i)=dh1dh2dh3_basic[0][i];
    1848                 *(Bprime_prog+NDOF1*numgrids*1+NDOF1*i)=dh1dh2dh3_basic[1][i];
    1849         }
    1850 }
    1851 /*}}}*/
    1852 /*FUNCTION GetNodalFunctions {{{1*/
    1853 #undef __FUNCT__
    1854 #define __FUNCT__ "Tria::GetNodalFunctions"
    1855 void Tria::GetNodalFunctions(double* l1l2l3, double* gauss_l1l2l3){
    1856        
    1857         /*This routine returns the values of the nodal functions  at the gaussian point.*/
    1858 
    1859         /*First nodal function: */
    1860         l1l2l3[0]=gauss_l1l2l3[0];
    1861 
    1862         /*Second nodal function: */
    1863         l1l2l3[1]=gauss_l1l2l3[1];
    1864 
    1865         /*Third nodal function: */
    1866         l1l2l3[2]=gauss_l1l2l3[2];
    1867 
    1868 }
    1869 /*}}}*/
    1870 /*FUNCTION GetNodalFunctionsDerivativesBasic {{{1*/
    1871 #undef __FUNCT__
    1872 #define __FUNCT__ "Tria::GetNodalFunctionsDerivativesBasic"
    1873 void Tria::GetNodalFunctionsDerivativesBasic(double* dh1dh2dh3_basic,double* xyz_list, double* gauss_l1l2l3){
    1874        
    1875         /*This routine returns the values of the nodal functions derivatives  (with respect to the
    1876          * basic coordinate system: */
    1877 
    1878         int i;
    1879         const int NDOF2=2;
    1880         const int numgrids=3;
    1881 
    1882         double dh1dh2dh3_param[NDOF2][numgrids];
    1883         double Jinv[NDOF2][NDOF2];
    1884 
    1885 
    1886         /*Get derivative values with respect to parametric coordinate system: */
    1887         GetNodalFunctionsDerivativesParams(&dh1dh2dh3_param[0][0], gauss_l1l2l3);
    1888 
    1889         /*Get Jacobian invert: */
    1890         GetJacobianInvert(&Jinv[0][0], xyz_list, gauss_l1l2l3);
    1891 
    1892         /*Build dh1dh2dh3_basic:
    1893          *
    1894          * [dhi/dx]= Jinv*[dhi/dr]
    1895          * [dhi/dy]       [dhi/ds]
    1896          */
    1897 
    1898         for (i=0;i<numgrids;i++){
    1899                 *(dh1dh2dh3_basic+numgrids*0+i)=Jinv[0][0]*dh1dh2dh3_param[0][i]+Jinv[0][1]*dh1dh2dh3_param[1][i];
    1900                 *(dh1dh2dh3_basic+numgrids*1+i)=Jinv[1][0]*dh1dh2dh3_param[0][i]+Jinv[1][1]*dh1dh2dh3_param[1][i];
    1901         }
    1902 
    1903 }
    1904 /*}}}*/
    1905 /*FUNCTION GetNodalFunctionsDerivativesParams {{{1*/
    1906 #undef __FUNCT__
    1907 #define __FUNCT__ "Tria::GetNodalFunctionsDerivativesParams"
    1908 void Tria::GetNodalFunctionsDerivativesParams(double* dl1dl2dl3,double* gauss_l1l2l3){
    1909        
    1910         /*This routine returns the values of the nodal functions derivatives  (with respect to the
    1911          * natural coordinate system) at the gaussian point. */
    1912 
    1913         const int NDOF2=2;
    1914         const int numgrids=3;
    1915 
    1916         double sqrt3=sqrt(3.0);
    1917 
    1918         /*First nodal function: */
    1919         *(dl1dl2dl3+numgrids*0+0)=-1.0/2.0;
    1920         *(dl1dl2dl3+numgrids*1+0)=-1.0/(2.0*sqrt3);
    1921 
    1922         /*Second nodal function: */
    1923         *(dl1dl2dl3+numgrids*0+1)=1.0/2.0;
    1924         *(dl1dl2dl3+numgrids*1+1)=-1.0/(2.0*sqrt3);
    1925 
    1926         /*Third nodal function: */
    1927         *(dl1dl2dl3+numgrids*0+2)=0;
    1928         *(dl1dl2dl3+numgrids*1+2)=1.0/sqrt3;
    1929 
    1930 }
    1931 /*}}}*/
    1932 /*FUNCTION GetJacobianInvert {{{1*/
    1933 #undef __FUNCT__
    1934 #define __FUNCT__ "Tria::GetJacobianInvert"
    1935 void Tria::GetJacobianInvert(double*  Jinv, double* xyz_list,double* gauss_l1l2l3){
    1936 
    1937         double Jdet;
    1938         const int NDOF2=2;
    1939         const int numgrids=3;
    1940        
    1941         /*Call Jacobian routine to get the jacobian:*/
    1942         GetJacobian(Jinv, xyz_list, gauss_l1l2l3);
    1943 
    1944         /*Invert Jacobian matrix: */
    1945         MatrixInverse(Jinv,NDOF2,NDOF2,NULL,0,&Jdet);
    1946                
    1947 }
    1948 /*}}}*/
    1949 /*FUNCTION GetJacobian {{{1*/
    1950 #undef __FUNCT__
    1951 #define __FUNCT__ "Tria::GetJacobian"
    1952 void Tria::GetJacobian(double* J, double* xyz_list,double* gauss_l1l2l3){
    1953 
    1954         /*The Jacobian is constant over the element, discard the gaussian points.
    1955          * J is assumed to have been allocated of size NDOF2xNDOF2.*/
    1956 
    1957         const int NDOF2=2;
    1958         const int numgrids=3;
    1959         double x1,y1,x2,y2,x3,y3;
    1960         double sqrt3=sqrt(3.0);
    1961        
    1962         x1=*(xyz_list+numgrids*0+0);
    1963         y1=*(xyz_list+numgrids*0+1);
    1964         x2=*(xyz_list+numgrids*1+0);
    1965         y2=*(xyz_list+numgrids*1+1);
    1966         x3=*(xyz_list+numgrids*2+0);
    1967         y3=*(xyz_list+numgrids*2+1);
    1968 
    1969 
    1970         *(J+NDOF2*0+0)=1.0/2.0*(x2-x1);
    1971         *(J+NDOF2*1+0)=sqrt3/6.0*(2*x3-x1-x2);
    1972         *(J+NDOF2*0+1)=1.0/2.0*(y2-y1);
    1973         *(J+NDOF2*1+1)=sqrt3/6.0*(2*y3-y1-y2);
    1974 }
    1975 /*}}}*/
    1976 /*FUNCTION GetMatPar {{{1*/
    1977 void* Tria::GetMatPar(){
    1978         return matpar;
    1979 }
    1980 /*}}}*/
    1981 /*FUNCTION GetShelf {{{1*/
    1982 int   Tria::GetShelf(){
    1983         return shelf;
    1984 }
    1985 /*}}}*/
    1986 /*FUNCTION GetNodes {{{1*/
    1987 void  Tria::GetNodes(void** vpnodes){
    1988         int i;
    1989         Node** pnodes=(Node**)vpnodes;
    1990 
    1991         for(i=0;i<3;i++){
    1992                 pnodes[i]=nodes[i];
    1993         }
    1994 }
    1995 /*}}}*/
    1996 /*FUNCTION GetOnBed {{{1*/
    1997 int Tria::GetOnBed(){
    1998         return onbed;
    1999 }
    2000 /*}}}*/
    20012958/*FUNCTION GetThicknessList {{{1*/
    20022959void Tria::GetThicknessList(double* thickness_list){
    … …  
    20062963}
    20072964/*}}}*/
    2008 /*FUNCTION GetBedList {{{1*/
    2009 void  Tria::GetBedList(double* bed_list){
    2010        
     2965/*FUNCTION Gradj {{{1*/
     2966#undef __FUNCT__
     2967#define __FUNCT__ "Tria::Gradj"
     2968void  Tria::Gradj(Vec grad_g,void* inputs,int analysis_type,int sub_analysis_type,char* control_type){
     2969
     2970        /*If on water, grad = 0: */
     2971        if(onwater)return;
     2972
     2973        if (strcmp(control_type,"drag")==0){
     2974                GradjDrag( grad_g,inputs,analysis_type,sub_analysis_type);
     2975        }
     2976        else if (strcmp(control_type,"B")==0){
     2977                GradjB( grad_g,inputs,analysis_type,sub_analysis_type);
     2978        }
     2979        else throw ErrorException(__FUNCT__,exprintf("%s%s","control type not supported yet: ",control_type));
     2980}
     2981/*}}}*/
     2982/*FUNCTION GradjB{{{1*/
     2983#undef __FUNCT__
     2984#define __FUNCT__ "Tria::GradjB"
     2985void  Tria::GradjB(Vec grad_g,void* vinputs,int analysis_type,int sub_analysis_type){
     2986
    20112987        int i;
    2012         for(i=0;i<3;i++)bed_list[i]=b[i];
    2013 
    2014 }
    2015 /*}}}*/
    2016 /*FUNCTION copy {{{1*/
    2017 Object* Tria::copy() {
    2018        
    2019         return new Tria(*this);
    2020 
    2021 }
    2022 /*}}}*/
    2023 /*FUNCTION Du {{{1*/
    2024 #undef __FUNCT__
    2025 #define __FUNCT__ "Tria::Du"
    2026 void Tria::Du(Vec du_g,void* vinputs,int analysis_type,int sub_analysis_type){
    2027 
    2028         int i;
    2029        
     2988
    20302989        /* node data: */
    20312990        const int    numgrids=3;
    2032         const int    numdof=2*numgrids;
     2991        const int    NDOF1=1;
    20332992        const int    NDOF2=2;
     2993        const int    numdof=NDOF2*numgrids;
    20342994        double       xyz_list[numgrids][3];
    2035         int          doflist[numdof];
    2036         int          numberofdofspernode;
    2037         int          dofs2[2]={0,1};
     2995        int          doflist1[numgrids];
     2996        double       dh1dh2dh3_basic[NDOF2][numgrids];
    20382997
    20392998        /* grid data: */
    2040         double vxvy_list[numgrids][2];
    20412999        double vx_list[numgrids];
    20423000        double vy_list[numgrids];
    2043         double obs_vxvy_list[numgrids][2];
    2044         double obs_vx_list[numgrids];
    2045         double obs_vy_list[numgrids];
    2046         double absolutex_list[numgrids];
    2047         double absolutey_list[numgrids];
    2048         double relativex_list[numgrids];
    2049         double relativey_list[numgrids];
    2050         double logarithmicx_list[numgrids];
    2051         double logarithmicy_list[numgrids];
     3001        double vxvy_list[numgrids][2];
     3002        double adjx_list[numgrids];
     3003        double adjy_list[numgrids];
     3004        double adjxadjy_list[numgrids][2];
     3005        double B[numgrids];
     3006
     3007        int    dofs1[1]={0};
     3008        int    dofs2[2]={0,1};
    20523009
    20533010        /* gaussian points: */
    … …  
    20603017        double  gauss_l1l2l3[3];
    20613018
    2062         /* parameters: */
    2063         double  obs_velocity_mag,velocity_mag;
    2064         double  absolutex,absolutey,relativex,relativey,logarithmicx,logarithmicy;
    2065 
    2066         /*element vector : */
    2067         double  due_g[numdof];
    2068         double  due_g_gaussian[numdof];
     3019        /*element vector at the gaussian points: */
     3020        double  grade_g[numgrids];
     3021        double  grade_g_gaussian[numgrids];
    20693022
    20703023        /* Jacobian: */
    … …  
    20743027        double l1l2l3[3];
    20753028
    2076         /*relative and algorithmic fitting: */
    2077         double scalex=0;
    2078         double scaley=0;
    2079         double scale=0;
    2080         double  fit=-1;
     3029        /* strain rate: */
     3030        double epsilon[3]; /* epsilon=[exx,eyy,exy];*/
     3031
     3032        /* parameters: */
     3033        double  viscosity_complement;
     3034        double  dvx[NDOF2];
     3035        double  dvy[NDOF2];
     3036        double  dadjx[NDOF2];
     3037        double  dadjy[NDOF2];
     3038        double  vx,vy;
     3039        double  lambda,mu;
     3040        double  thickness;
     3041        int     dofs[1]={0};
     3042        double  dB[NDOF2];
     3043        double  B_gauss;
    20813044
    20823045        ParameterInputs* inputs=NULL;
    … …  
    20873050        /* Get node coordinates and dof list: */
    20883051        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    2089         GetDofList(&doflist[0],&numberofdofspernode);
    2090 
    2091         /* Set due_g to 0: */
    2092         for(i=0;i<numdof;i++) due_g[i]=0.0;
    2093 
    2094         /* Recover input data: */
    2095         if(!inputs->Recover("fit",&fit)) throw ErrorException(__FUNCT__," missing fit input parameter");
    2096         if(!inputs->Recover("velocity_obs",&obs_vxvy_list[0][0],2,dofs2,numgrids,(void**)nodes)){
    2097                 throw ErrorException(__FUNCT__,"missing velocity_obs input parameter");
    2098         }
     3052        GetDofList1(&doflist1[0]);
     3053
     3054        /* Set grade_g to 0: */
     3055        for(i=0;i<numgrids;i++) grade_g[i]=0.0;
     3056
     3057        /* recover input parameters: */
     3058        inputs->Recover("thickness",&h[0],1,dofs,numgrids,(void**)nodes);
    20993059        if(!inputs->Recover("velocity",&vxvy_list[0][0],2,dofs2,numgrids,(void**)nodes)){
    21003060                throw ErrorException(__FUNCT__,"missing velocity input parameter");
    21013061        }
    2102 
     3062        if(!inputs->Recover("adjoint",&adjxadjy_list[0][0],2,dofs2,numgrids,(void**)nodes)){
     3063                throw ErrorException(__FUNCT__,"missing adjoint input parameter");
     3064        }
     3065        if(!inputs->Recover("B",&B[0],1,dofs1,numgrids,(void**)nodes)){
     3066                throw ErrorException(__FUNCT__,"parameter B not found in input");
     3067        }
     3068
     3069        /*Initialize parameter lists: */
    21033070        for(i=0;i<numgrids;i++){
    2104                 obs_vx_list[i]=obs_vxvy_list[i][0];
    2105                 obs_vy_list[i]=obs_vxvy_list[i][1];
    21063071                vx_list[i]=vxvy_list[i][0];
    21073072                vy_list[i]=vxvy_list[i][1];
    2108         }
    2109 
    2110         /*Get Du at the 3 nodes (integration of the linearized function)*/
    2111         if(fit==0){
    2112                 /*We are using an absolute misfit: */
    2113                 for (i=0;i<numgrids;i++){
    2114                         absolutex_list[i]=obs_vx_list[i]-vx_list[i];
    2115                         absolutey_list[i]=obs_vy_list[i]-vy_list[i];
    2116                 }
    2117         }
    2118         else if(fit==1){
    2119                 /*We are using a relative misfit: */
    2120                 for (i=0;i<numgrids;i++){
    2121                         scalex=pow(numpar->meanvel/(obs_vx_list[i]+numpar->epsvel),2);
    2122                         scaley=pow(numpar->meanvel/(obs_vy_list[i]+numpar->epsvel),2);
    2123                         if(obs_vx_list[i]==0)scalex=0;
    2124                         if(obs_vy_list[i]==0)scaley=0;
    2125                         relativex_list[i]=scalex*(obs_vx_list[i]-vx_list[i]);
    2126                         relativey_list[i]=scaley*(obs_vy_list[i]-vy_list[i]);
    2127                 }
    2128         }
    2129         else if(fit==2){
    2130                 /*We are using a logarithmic misfit: */
    2131                 for (i=0;i<numgrids;i++){
    2132                         velocity_mag=sqrt(pow(vx_list[i],2)+pow(vy_list[i],2))+numpar->epsvel; //epsvel to avoid velocity being nil.
    2133                         obs_velocity_mag=sqrt(pow(obs_vx_list[i],2)+pow(obs_vy_list[i],2))+numpar->epsvel; //epsvel to avoid observed velocity being nil.
    2134                         scale=-8*pow(numpar->meanvel,2)/pow(velocity_mag,2)*log(velocity_mag/obs_velocity_mag);
    2135                         logarithmicx_list[i]=scale*vx_list[i];
    2136                         logarithmicy_list[i]=scale*vy_list[i];
    2137                 }
    2138         }
    2139         else{
    2140                 /*Not supported yet! : */
    2141                 throw ErrorException(__FUNCT__,exprintf("%s%g","unsupported type of fit: ",fit));
    2142         }
    2143        
     3073                adjx_list[i]=adjxadjy_list[i][0];
     3074                adjy_list[i]=adjxadjy_list[i][1];
     3075        }
     3076
    21443077        /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
    2145         GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
    2146 
    2147         #ifdef _DEBUGELEMENTS_
    2148         if(my_rank==RANK && id==ELID){
    2149                 printf("   gaussian points: \n");
    2150                 for(i=0;i<num_gauss;i++){
    2151                         printf("    %g %g %g : %g\n",first_gauss_area_coord[i],second_gauss_area_coord[i],third_gauss_area_coord[i],gauss_weights[i]);
    2152                 }
    2153         }
    2154         #endif
    2155        
     3078        GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 4);
     3079#ifdef _ISSM_DEBUG_
     3080        for (i=0;i<num_gauss;i++){
     3081                printf("Gauss coord %i: %lf %lf %lf Weight: %lf\n",i,*(first_gauss_area_coord+i),*(second_gauss_area_coord+i),*(third_gauss_area_coord+i),*(gauss_weights+i));
     3082        }
     3083#endif
     3084
    21563085        /* Start  looping on the number of gaussian points: */
    21573086        for (ig=0; ig<num_gauss; ig++){
    … …  
    21623091                gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
    21633092
     3093                /*Get thickness: */
     3094                GetParameterValue(&thickness, &h[0],gauss_l1l2l3);
     3095
     3096                /*Get strain rate, if velocity has been supplied: */
     3097                GetStrainRate(&epsilon[0],&vxvy_list[0][0],&xyz_list[0][0],gauss_l1l2l3);
     3098
     3099                /*Get viscosity complement: */
     3100                matice->GetViscosityComplement(&viscosity_complement, &epsilon[0]);
     3101
     3102                /*Get dvx, dvy, dadjx and dadjx: */
     3103                GetParameterDerivativeValue(&dvx[0], &vx_list[0],&xyz_list[0][0], gauss_l1l2l3);
     3104                GetParameterDerivativeValue(&dvy[0], &vy_list[0],&xyz_list[0][0], gauss_l1l2l3);
     3105                GetParameterDerivativeValue(&dadjx[0], &adjx_list[0],&xyz_list[0][0], gauss_l1l2l3);
     3106                GetParameterDerivativeValue(&dadjy[0], &adjy_list[0],&xyz_list[0][0], gauss_l1l2l3);
     3107
    21643108                /* Get Jacobian determinant: */
    21653109                GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
    2166                 #ifdef _ISSM_DEBUG_
    2167                 printf("Element id %i Jacobian determinant: %g\n",GetId(),Jdet);
    2168                 #endif
    2169                
     3110
    21703111                /* Get nodal functions value at gaussian point:*/
    21713112                GetNodalFunctions(l1l2l3, gauss_l1l2l3);
    2172 
    2173                 /*Build due_g_gaussian vector: we have three cases here, according to which type of misfit we are using. */
    2174                 if(fit==0){
    2175                         /*We are using an absolute misfit: */
    2176 
    2177                         /*Compute absolute(x/y) at gaussian point: */
    2178                         GetParameterValue(&absolutex, &absolutex_list[0],gauss_l1l2l3);
    2179                         GetParameterValue(&absolutey, &absolutey_list[0],gauss_l1l2l3);
    2180 
    2181                         /*compute Du*/
    2182                         for (i=0;i<numgrids;i++){
    2183                                 due_g_gaussian[i*NDOF2+0]=absolutex*Jdet*gauss_weight*l1l2l3[i];
    2184                                 due_g_gaussian[i*NDOF2+1]=absolutey*Jdet*gauss_weight*l1l2l3[i];
     3113#ifdef _ISSM_DEBUG_
     3114                printf("viscositycomp %g thickness %g dvx [%g %g] dvy [%g %g]  dadjx [%g %g] dadjy[%g %g]\n",viscosity_complement,thickness,dvx[0],dvx[1],dvy[0],dvy[1],dadjx[0],dadjx[1],dadjy[0],dadjy[1]);
     3115#endif
     3116
     3117                /*Get nodal functions derivatives*/
     3118                GetNodalFunctionsDerivativesBasic(&dh1dh2dh3_basic[0][0],&xyz_list[0][0],gauss_l1l2l3);
     3119
     3120                /*Get B derivative: dB/dx */
     3121                GetParameterDerivativeValue(&dB[0], &B[0],&xyz_list[0][0], gauss_l1l2l3);
     3122                GetParameterValue(&B_gauss, &B[0],gauss_l1l2l3);
     3123
     3124                /*Build gradje_g_gaussian vector (actually -dJ/dB): */
     3125                for (i=0;i<numgrids;i++){
     3126                        //standard gradient dJ/dki
     3127                        grade_g_gaussian[i]=-viscosity_complement*thickness*( (2*dvx[0]+dvy[1])*2*dadjx[0]+(dvx[1]+dvy[0])*(dadjx[1]+dadjy[0])+(2*dvy[1]+dvx[0])*2*dadjy[1])*Jdet*gauss_weight*l1l2l3[i];
     3128
     3129                        //Add regularization term
     3130                        grade_g_gaussian[i]-=numpar->cm_noisedmp*Jdet*gauss_weight*(dh1dh2dh3_basic[0][i]*dB[0]+dh1dh2dh3_basic[1][i]*dB[1]);
     3131
     3132                        //min dampening
     3133                        if(B_gauss<numpar->cm_mindmp_value){
     3134                                grade_g_gaussian[i]+= numpar->cm_mindmp_slope*Jdet*gauss_weight*l1l2l3[i];
    21853135                        }
    2186                 }
    2187                 else if(fit==1){
    2188                         /*We are using a relative misfit: */
    2189 
    2190                         /*Compute relative(x/y) at gaussian point: */
    2191                         GetParameterValue(&relativex, &relativex_list[0],gauss_l1l2l3);
    2192                         GetParameterValue(&relativey, &relativey_list[0],gauss_l1l2l3);
    2193 
    2194                         /*compute Du*/
    2195                         for (i=0;i<numgrids;i++){
    2196                                 due_g_gaussian[i*NDOF2+0]=relativex*Jdet*gauss_weight*l1l2l3[i];
    2197                                 due_g_gaussian[i*NDOF2+1]=relativey*Jdet*gauss_weight*l1l2l3[i];
     3136
     3137                        //max dampening
     3138                        if(B_gauss>numpar->cm_maxdmp_value){
     3139                                grade_g_gaussian[i]+= - numpar->cm_maxdmp_slope*Jdet*gauss_weight*l1l2l3[i];
    21983140                        }
    2199                 }
    2200                 else if(fit==2){
    2201                         /*We are using a logarithmic misfit: */
    2202 
    2203                         /*Compute logarithmic(x/y) at gaussian point: */
    2204                         GetParameterValue(&logarithmicx, &logarithmicx_list[0],gauss_l1l2l3);
    2205                         GetParameterValue(&logarithmicy, &logarithmicy_list[0],gauss_l1l2l3);
    2206 
    2207                         /*compute Du*/
    2208                         for (i=0;i<numgrids;i++){
    2209                                 due_g_gaussian[i*NDOF2+0]=logarithmicx*Jdet*gauss_weight*l1l2l3[i];
    2210                                 due_g_gaussian[i*NDOF2+1]=logarithmicy*Jdet*gauss_weight*l1l2l3[i];
    2211                         }
    2212                 }
    2213                 else{
    2214                         /*Not supported yet! : */
    2215                         throw ErrorException(__FUNCT__,exprintf("%s%g","unsupported type of fit: ",fit));
    2216                 }
    2217                
    2218                 /*Add due_g_gaussian vector to due_g: */
    2219                 for( i=0; i<numdof; i++){
    2220                         due_g[i]+=due_g_gaussian[i];
    2221                 }
    2222         }
    2223        
    2224         /*Add due_g to global vector du_g: */
    2225         VecSetValues(du_g,numdof,doflist,(const double*)due_g,ADD_VALUES);
    2226        
    2227         cleanup_and_return:
     3141
     3142                }
     3143
     3144                /*Add grade_g_gaussian to grade_g: */
     3145                for( i=0; i<numgrids;i++) grade_g[i]+=grade_g_gaussian[i];
     3146        }
     3147
     3148        /*Add grade_g to global vector grad_g: */
     3149        VecSetValues(grad_g,numgrids,doflist1,(const double*)grade_g,ADD_VALUES);
     3150
     3151cleanup_and_return:
    22283152        xfree((void**)&first_gauss_area_coord);
    22293153        xfree((void**)&second_gauss_area_coord);
    22303154        xfree((void**)&third_gauss_area_coord);
    22313155        xfree((void**)&gauss_weights);
    2232 
    2233 }
    2234 /*}}}*/
    2235 /*FUNCTION Gradj {{{1*/
    2236 #undef __FUNCT__
    2237 #define __FUNCT__ "Tria::Gradj"
    2238 void  Tria::Gradj(Vec grad_g,void* inputs,int analysis_type,int sub_analysis_type,char* control_type){
    2239 
    2240         /*If on water, grad = 0: */
    2241         if(onwater)return;
    2242 
    2243         if (strcmp(control_type,"drag")==0){
    2244                 GradjDrag( grad_g,inputs,analysis_type,sub_analysis_type);
    2245         }
    2246         else if (strcmp(control_type,"B")==0){
    2247                 GradjB( grad_g,inputs,analysis_type,sub_analysis_type);
    2248         }
    2249         else throw ErrorException(__FUNCT__,exprintf("%s%s","control type not supported yet: ",control_type));
    22503156}
    22513157/*}}}*/
    … …  
    27063612}
    27073613/*}}}*/
    2708 /*FUNCTION SurfaceNormal{{{1*/
    2709 #undef __FUNCT__
    2710 #define __FUNCT__ "Tria::SurfaceNormal"
    2711 
    2712 void Tria::SurfaceNormal(double* surface_normal, double xyz_list[3][3]){
    2713 
    2714         int i;
    2715         double v13[3];
    2716         double v23[3];
    2717         double normal[3];
    2718         double normal_norm;
    2719 
    2720         for (i=0;i<3;i++){
    2721                 v13[i]=xyz_list[0][i]-xyz_list[2][i];
    2722                 v23[i]=xyz_list[1][i]-xyz_list[2][i];
    2723         }
    2724 
    2725         normal[0]=v13[1]*v23[2]-v13[2]*v23[1];
    2726         normal[1]=v13[2]*v23[0]-v13[0]*v23[2];
    2727         normal[2]=v13[0]*v23[1]-v13[1]*v23[0];
    2728 
    2729         normal_norm=sqrt( pow(normal[0],(double)2)+pow(normal[1],(double)2)+pow(normal[2],(double)2) );
    2730 
    2731         *(surface_normal)=normal[0]/normal_norm;
    2732         *(surface_normal+1)=normal[1]/normal_norm;
    2733         *(surface_normal+2)=normal[2]/normal_norm;
    2734 
    2735 }
    2736 /*}}}*/
    2737 /*FUNCTION GradjB{{{1*/
    2738 #undef __FUNCT__
    2739 #define __FUNCT__ "Tria::GradjB"
    2740 void  Tria::GradjB(Vec grad_g,void* vinputs,int analysis_type,int sub_analysis_type){
    2741 
    2742         int i;
    2743 
    2744         /* node data: */
    2745         const int    numgrids=3;
    2746         const int    NDOF1=1;
    2747         const int    NDOF2=2;
    2748         const int    numdof=NDOF2*numgrids;
    2749         double       xyz_list[numgrids][3];
    2750         int          doflist1[numgrids];
    2751         double       dh1dh2dh3_basic[NDOF2][numgrids];
    2752 
    2753         /* grid data: */
    2754         double vx_list[numgrids];
    2755         double vy_list[numgrids];
    2756         double vxvy_list[numgrids][2];
    2757         double adjx_list[numgrids];
    2758         double adjy_list[numgrids];
    2759         double adjxadjy_list[numgrids][2];
    2760         double B[numgrids];
    2761 
    2762         int    dofs1[1]={0};
    2763         int    dofs2[2]={0,1};
    2764 
    2765         /* gaussian points: */
    2766         int     num_gauss,ig;
    2767         double* first_gauss_area_coord  =  NULL;
    2768         double* second_gauss_area_coord =  NULL;
    2769         double* third_gauss_area_coord  =  NULL;
    2770         double* gauss_weights           =  NULL;
    2771         double  gauss_weight;
    2772         double  gauss_l1l2l3[3];
    2773 
    2774         /*element vector at the gaussian points: */
    2775         double  grade_g[numgrids];
    2776         double  grade_g_gaussian[numgrids];
    2777 
    2778         /* Jacobian: */
    2779         double Jdet;
    2780 
    2781         /*nodal functions: */
    2782         double l1l2l3[3];
    2783 
    2784         /* strain rate: */
    2785         double epsilon[3]; /* epsilon=[exx,eyy,exy];*/
    2786 
    2787         /* parameters: */
    2788         double  viscosity_complement;
    2789         double  dvx[NDOF2];
    2790         double  dvy[NDOF2];
    2791         double  dadjx[NDOF2];
    2792         double  dadjy[NDOF2];
    2793         double  vx,vy;
    2794         double  lambda,mu;
    2795         double  thickness;
    2796         int     dofs[1]={0};
    2797         double  dB[NDOF2];
    2798         double  B_gauss;
    2799        
    2800         ParameterInputs* inputs=NULL;
    2801 
    2802         /*recover pointers: */
    2803         inputs=(ParameterInputs*)vinputs;
    2804 
    2805         /* Get node coordinates and dof list: */
    2806         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    2807         GetDofList1(&doflist1[0]);
    2808 
    2809         /* Set grade_g to 0: */
    2810         for(i=0;i<numgrids;i++) grade_g[i]=0.0;
    2811 
    2812         /* recover input parameters: */
    2813         inputs->Recover("thickness",&h[0],1,dofs,numgrids,(void**)nodes);
    2814         if(!inputs->Recover("velocity",&vxvy_list[0][0],2,dofs2,numgrids,(void**)nodes)){
    2815                 throw ErrorException(__FUNCT__,"missing velocity input parameter");
    2816         }
    2817         if(!inputs->Recover("adjoint",&adjxadjy_list[0][0],2,dofs2,numgrids,(void**)nodes)){
    2818                 throw ErrorException(__FUNCT__,"missing adjoint input parameter");
    2819         }
    2820         if(!inputs->Recover("B",&B[0],1,dofs1,numgrids,(void**)nodes)){
    2821                 throw ErrorException(__FUNCT__,"parameter B not found in input");
    2822         }
    2823 
    2824         /*Initialize parameter lists: */
    2825         for(i=0;i<numgrids;i++){
    2826                 vx_list[i]=vxvy_list[i][0];
    2827                 vy_list[i]=vxvy_list[i][1];
    2828                 adjx_list[i]=adjxadjy_list[i][0];
    2829                 adjy_list[i]=adjxadjy_list[i][1];
    2830         }
    2831        
    2832         /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
    2833         GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 4);
    2834         #ifdef _ISSM_DEBUG_
    2835         for (i=0;i<num_gauss;i++){
    2836                 printf("Gauss coord %i: %lf %lf %lf Weight: %lf\n",i,*(first_gauss_area_coord+i),*(second_gauss_area_coord+i),*(third_gauss_area_coord+i),*(gauss_weights+i));
    2837         }
    2838         #endif
    2839 
    2840         /* Start  looping on the number of gaussian points: */
    2841         for (ig=0; ig<num_gauss; ig++){
    2842                 /*Pick up the gaussian point: */
    2843                 gauss_weight=*(gauss_weights+ig);
    2844                 gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
    2845                 gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
    2846                 gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
    2847 
    2848                 /*Get thickness: */
    2849                 GetParameterValue(&thickness, &h[0],gauss_l1l2l3);
    2850        
    2851                 /*Get strain rate, if velocity has been supplied: */
    2852                 GetStrainRate(&epsilon[0],&vxvy_list[0][0],&xyz_list[0][0],gauss_l1l2l3);
    2853        
    2854                 /*Get viscosity complement: */
    2855                 matice->GetViscosityComplement(&viscosity_complement, &epsilon[0]);
    2856                
    2857                 /*Get dvx, dvy, dadjx and dadjx: */
    2858                 GetParameterDerivativeValue(&dvx[0], &vx_list[0],&xyz_list[0][0], gauss_l1l2l3);
    2859                 GetParameterDerivativeValue(&dvy[0], &vy_list[0],&xyz_list[0][0], gauss_l1l2l3);
    2860                 GetParameterDerivativeValue(&dadjx[0], &adjx_list[0],&xyz_list[0][0], gauss_l1l2l3);
    2861                 GetParameterDerivativeValue(&dadjy[0], &adjy_list[0],&xyz_list[0][0], gauss_l1l2l3);
    2862 
    2863                 /* Get Jacobian determinant: */
    2864                 GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
    2865                
    2866                 /* Get nodal functions value at gaussian point:*/
    2867                 GetNodalFunctions(l1l2l3, gauss_l1l2l3);
    2868                 #ifdef _ISSM_DEBUG_
    2869                         printf("viscositycomp %g thickness %g dvx [%g %g] dvy [%g %g]  dadjx [%g %g] dadjy[%g %g]\n",viscosity_complement,thickness,dvx[0],dvx[1],dvy[0],dvy[1],dadjx[0],dadjx[1],dadjy[0],dadjy[1]);
    2870                 #endif
    2871 
    2872                 /*Get nodal functions derivatives*/
    2873                 GetNodalFunctionsDerivativesBasic(&dh1dh2dh3_basic[0][0],&xyz_list[0][0],gauss_l1l2l3);
    2874 
    2875                 /*Get B derivative: dB/dx */
    2876                 GetParameterDerivativeValue(&dB[0], &B[0],&xyz_list[0][0], gauss_l1l2l3);
    2877                 GetParameterValue(&B_gauss, &B[0],gauss_l1l2l3);
    2878 
    2879                 /*Build gradje_g_gaussian vector (actually -dJ/dB): */
    2880                 for (i=0;i<numgrids;i++){
    2881                         //standard gradient dJ/dki
    2882                         grade_g_gaussian[i]=-viscosity_complement*thickness*( (2*dvx[0]+dvy[1])*2*dadjx[0]+(dvx[1]+dvy[0])*(dadjx[1]+dadjy[0])+(2*dvy[1]+dvx[0])*2*dadjy[1])*Jdet*gauss_weight*l1l2l3[i];
    2883 
    2884                         //Add regularization term
    2885                         grade_g_gaussian[i]-=numpar->cm_noisedmp*Jdet*gauss_weight*(dh1dh2dh3_basic[0][i]*dB[0]+dh1dh2dh3_basic[1][i]*dB[1]);
    2886 
    2887                         //min dampening
    2888                         if(B_gauss<numpar->cm_mindmp_value){
    2889                                 grade_g_gaussian[i]+= numpar->cm_mindmp_slope*Jdet*gauss_weight*l1l2l3[i];
    2890                         }
    2891 
    2892                         //max dampening
    2893                         if(B_gauss>numpar->cm_maxdmp_value){
    2894                                 grade_g_gaussian[i]+= - numpar->cm_maxdmp_slope*Jdet*gauss_weight*l1l2l3[i];
    2895                         }
    2896 
    2897                 }
    2898 
    2899                 /*Add grade_g_gaussian to grade_g: */
    2900                 for( i=0; i<numgrids;i++) grade_g[i]+=grade_g_gaussian[i];
    2901         }
    2902        
    2903         /*Add grade_g to global vector grad_g: */
    2904         VecSetValues(grad_g,numgrids,doflist1,(const double*)grade_g,ADD_VALUES);
    2905        
    2906         cleanup_and_return:
    2907         xfree((void**)&first_gauss_area_coord);
    2908         xfree((void**)&second_gauss_area_coord);
    2909         xfree((void**)&third_gauss_area_coord);
    2910         xfree((void**)&gauss_weights);
    2911 }
    2912 /*}}}*/
    2913 /*FUNCTION Misfit {{{1*/
    2914 #undef __FUNCT__
    2915 #define __FUNCT__ "Tria::Misfit"
    2916 double Tria::Misfit(void* vinputs,int analysis_type,int sub_analysis_type){
    2917 
    2918         int i;
    2919        
    2920         /* output: */
    2921         double Jelem=0;
    2922 
    2923         /* node data: */
    2924         const int    numgrids=3;
    2925         const int    numdof=2*numgrids;
    2926         const int    NDOF2=2;
    2927         int          dofs1[1]={0};
    2928         int          dofs2[2]={0,1};
    2929         double       xyz_list[numgrids][3];
    2930 
    2931         /* grid data: */
    2932         double vxvy_list[numgrids][2];
    2933         double vx_list[numgrids];
    2934         double vy_list[numgrids];
    2935         double obs_vxvy_list[numgrids][2];
    2936         double obs_vx_list[numgrids];
    2937         double obs_vy_list[numgrids];
    2938         double absolute_list[numgrids];
    2939         double relative_list[numgrids];
    2940         double logarithmic_list[numgrids];
    2941         double B[numgrids];
    2942 
    2943         /* gaussian points: */
    2944         int     num_gauss,ig;
    2945         double* first_gauss_area_coord  =  NULL;
    2946         double* second_gauss_area_coord =  NULL;
    2947         double* third_gauss_area_coord  =  NULL;
    2948         double* gauss_weights           =  NULL;
    2949         double  gauss_weight;
    2950         double  gauss_l1l2l3[3];
    2951         double  k_gauss;
    2952         double  B_gauss;
    2953 
    2954         /* parameters: */
    2955         double  velocity_mag,obs_velocity_mag;
    2956         double  absolute,relative,logarithmic;
    2957         double  dk[NDOF2];
    2958         double  dB[NDOF2];
    2959 
    2960         /* Jacobian: */
    2961         double Jdet;
    2962        
    2963         /*relative and logarithmic control method :*/
    2964         double scalex=1;
    2965         double scaley=1;
    2966         double  fit=-1;
    2967 
    2968         ParameterInputs* inputs=NULL;
    2969 
    2970         /*If on water, return 0: */
    2971         if(onwater)return 0;
    2972 
    2973         /*recover pointers: */
    2974         inputs=(ParameterInputs*)vinputs;
    2975 
    2976         /* Get node coordinates and dof list: */
    2977         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    2978        
    2979         /* Recover input data: */
    2980         if(!inputs->Recover("fit",&fit)) throw ErrorException(__FUNCT__," missing fit input parameter");
    2981         if(!inputs->Recover("velocity_obs",&obs_vxvy_list[0][0],2,dofs2,numgrids,(void**)nodes)){
    2982                 throw ErrorException(__FUNCT__,"missing velocity_obs input parameter");
    2983         }
    2984         if(!inputs->Recover("velocity",&vxvy_list[0][0],2,dofs2,numgrids,(void**)nodes)){
    2985                 throw ErrorException(__FUNCT__,"missing velocity input parameter");
    2986         }
    2987 
    2988         /*Initialize velocities: */
    2989         for(i=0;i<numgrids;i++){
    2990                 obs_vx_list[i]=obs_vxvy_list[i][0];
    2991                 obs_vy_list[i]=obs_vxvy_list[i][1];
    2992                 vx_list[i]=vxvy_list[i][0];
    2993                 vy_list[i]=vxvy_list[i][1];
    2994         }
    2995 
    2996         /*Compute Misfit at the 3 nodes (integration of the linearized function)*/
    2997         if(fit==0){
    2998                 /*We are using an absolute misfit: */
    2999                 for (i=0;i<numgrids;i++){
    3000                         absolute_list[i]=0.5*(pow((vx_list[i]-obs_vx_list[i]),(double)2)+pow((vy_list[i]-obs_vy_list[i]),(double)2));
    3001                 }
    3002         }
    3003         else if(fit==1){
    3004                 /*We are using a relative misfit: */
    3005                 for (i=0;i<numgrids;i++){
    3006                         scalex=pow(numpar->meanvel/(obs_vx_list[i]+numpar->epsvel),(double)2);
    3007                         scaley=pow(numpar->meanvel/(obs_vy_list[i]+numpar->epsvel),(double)2);
    3008                         if(obs_vx_list[i]==0)scalex=0;
    3009                         if(obs_vy_list[i]==0)scaley=0;
    3010                         relative_list[i]=0.5*(scalex*pow((vx_list[i]-obs_vx_list[i]),2)+scaley*pow((vy_list[i]-obs_vy_list[i]),2));
    3011                 }
    3012         }
    3013         else if(fit==2){
    3014                 /*We are using a logarithmic misfit: */
    3015                 for (i=0;i<numgrids;i++){
    3016                         velocity_mag=sqrt(pow(vx_list[i],(double)2)+pow(vy_list[i],(double)2))+numpar->epsvel; //epsvel to avoid velocity being nil.
    3017                         obs_velocity_mag=sqrt(pow(obs_vx_list[i],(double)2)+pow(obs_vy_list[i],(double)2))+numpar->epsvel; //epsvel to avoid observed velocity being nil.
    3018                         logarithmic_list[i]=4*pow(numpar->meanvel,(double)2)*pow(log(velocity_mag/obs_velocity_mag),(double)2);
    3019                 }
    3020         }
    3021         else{
    3022                 /*Not supported yet! : */
    3023                 throw ErrorException(__FUNCT__,exprintf("%s%g","unsupported type of fit: ",fit));
    3024         }
    3025 
    3026         /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
    3027         GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
    3028        
    3029         #ifdef _ISSM_DEBUG_
    3030         for (i=0;i<num_gauss;i++){
    3031                 printf("Gauss coord %i: %lf %lf %lf Weight: %lf\n",i,*(first_gauss_area_coord+i),*(second_gauss_area_coord+i),*(third_gauss_area_coord+i),*(gauss_weights+i));
    3032         }
    3033         #endif
    3034 
    3035         /* Start  looping on the number of gaussian points: */
    3036         for (ig=0; ig<num_gauss; ig++){
    3037                 /*Pick up the gaussian point: */
    3038                 gauss_weight=*(gauss_weights+ig);
    3039                 gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
    3040                 gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
    3041                 gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
    3042 
    3043                 /* Get Jacobian determinant: */
    3044                 GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
    3045                 #ifdef _ISSM_DEBUG_
    3046                 printf("Element id %i Jacobian determinant: %lf\n",GetId(),Jdet);
    3047                 #endif
    3048                
    3049                 /*Add dampening terms to misfit*/
    3050                 if (strcmp(numpar->control_type,"drag")==0){
    3051                         if (!shelf){
    3052 
    3053                                 //noise dampening
    3054                                 GetParameterDerivativeValue(&dk[0], &k[0],&xyz_list[0][0], gauss_l1l2l3);
    3055                                 Jelem+=numpar->cm_noisedmp*1/2*(pow(dk[0],2)+pow(dk[1],2))*Jdet*gauss_weight;
    3056 
    3057                         }
    3058                 }
    3059                 else if (strcmp(numpar->control_type,"B")==0){
    3060                         if(!inputs->Recover("B",&B[0],1,dofs1,numgrids,(void**)nodes)){
    3061                                 throw ErrorException(__FUNCT__,"parameter B not found in input");
    3062                         }
    3063                         //noise dampening
    3064                         GetParameterDerivativeValue(&dB[0], &B[0],&xyz_list[0][0], gauss_l1l2l3);
    3065                         Jelem+=numpar->cm_noisedmp*1/2*(pow(dB[0],2)+pow(dB[1],2))*Jdet*gauss_weight;
    3066 
    3067                         //min dampening
    3068                         GetParameterValue(&B_gauss, &B[0],gauss_l1l2l3);
    3069                         if(B_gauss<numpar->cm_mindmp_value){
    3070                                 Jelem+=numpar->cm_mindmp_slope*B_gauss*Jdet*gauss_weight;
    3071                         }
    3072 
    3073                         //max dampening
    3074                         if(B_gauss>numpar->cm_maxdmp_value){
    3075                                 Jelem+=numpar->cm_maxdmp_slope*B_gauss*Jdet*gauss_weight;
    3076                         }
    3077                 }
    3078                 else{
    3079                         throw ErrorException(__FUNCT__,exprintf("%s%s","unsupported control type: ",numpar->control_type));
    3080                 }
    3081 
    3082                 /*Differents misfits are allowed: */
    3083                 if(fit==0){
    3084                         /*Compute absolute misfit at gaussian point: */
    3085                         GetParameterValue(&absolute, &absolute_list[0],gauss_l1l2l3);
    3086 
    3087                         /*compute Misfit*/
    3088                         Jelem+=absolute*Jdet*gauss_weight;
    3089                 }
    3090                 else if(fit==1){
    3091                         /*Compute relative misfit at gaussian point: */
    3092                         GetParameterValue(&relative, &relative_list[0],gauss_l1l2l3);
    3093 
    3094                         /*compute Misfit*/
    3095                         Jelem+=relative*Jdet*gauss_weight;
    3096                 }       
    3097                 else if(fit==2){
    3098                         /*Compute logarithmic misfit at gaussian point: */
    3099                         GetParameterValue(&logarithmic, &logarithmic_list[0],gauss_l1l2l3);
    3100 
    3101                         /*compute Misfit*/
    3102                         Jelem+=logarithmic*Jdet*gauss_weight;
    3103                 }
    3104                 else throw ErrorException(__FUNCT__,exprintf("%s%i%s","fit type",fit," not supported yet!"));
    3105 
    3106         }
    3107         cleanup_and_return:
    3108         xfree((void**)&first_gauss_area_coord);
    3109         xfree((void**)&second_gauss_area_coord);
    3110         xfree((void**)&third_gauss_area_coord);
    3111         xfree((void**)&gauss_weights);
    3112 
    3113         /*Return: */
    3114         return Jelem;
    3115 }
    3116 /*}}}*/
    3117 /*FUNCTION NodeConfiguration {{{1*/
    3118 #undef __FUNCT__
    3119 #define __FUNCT__ "Tria::NodeConfiguration"
    3120 void  Tria::NodeConfiguration(int* tria_node_ids,Node* tria_nodes[3],int* tria_node_offsets){
    3121 
    3122         int i;
    3123         for(i=0;i<3;i++){
    3124                 node_ids[i]=tria_node_ids[i];
    3125                 nodes[i]=tria_nodes[i];
    3126                 node_offsets[i]=tria_node_offsets[i];
    3127         }
    3128 
    3129 }
    3130 /*}}}*/
    3131 /*FUNCTION MaticeConfiguration {{{1*/
    3132 #undef __FUNCT__
    3133 #define __FUNCT__ "Tria::MaticeConfiguration"
    3134 void  Tria::MaticeConfiguration(Matice* tria_matice,int tria_matice_offset){
    3135         matice=tria_matice;
    3136         matice_offset=tria_matice_offset;
    3137 }
    3138 /*}}}*/
    3139 /*FUNCTION MatparConfiguration {{{1*/
    3140 #undef __FUNCT__
    3141 #define __FUNCT__ "Tria::MatparConfiguration"
    3142 void  Tria::MatparConfiguration(Matpar* tria_matpar,int tria_matpar_offset){
    3143 
    3144         matpar=tria_matpar;
    3145         matpar_offset=tria_matpar_offset;
    3146 
    3147 }
    3148 /*}}}*/
    3149 /*FUNCTION NumparConfiguration {{{1*/
    3150 #undef __FUNCT__
    3151 #define __FUNCT__ "Tria::NumparConfiguration"
    3152 void  Tria::NumparConfiguration(Numpar* tria_numpar,int tria_numpar_offset){
    3153 
    3154         numpar=tria_numpar;
    3155         numpar_offset=tria_numpar_offset;
    3156 
    3157 }
    3158 /*}}}*/
    3159 /*FUNCTION CreateKMatrixDiagnosticSurfaceVert {{{1*/
    3160 #undef __FUNCT__
    3161 #define __FUNCT__ "Tria::CreateKMatrixDiagnosticSurfaceVert"
    3162 void  Tria::CreateKMatrixDiagnosticSurfaceVert(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
    3163 
    3164         int i,j;
    3165        
    3166         /* node data: */
    3167         const int    numgrids=3;
    3168         const int    NDOF1=1;
    3169         const int    numdof=NDOF1*numgrids;
    3170         double       xyz_list[numgrids][3];
    3171         int          doflist[numdof];
    3172         int          numberofdofspernode;
    3173 
    3174         /* gaussian points: */
    3175         int     num_gauss,ig;
    3176         double* first_gauss_area_coord  =  NULL;
    3177         double* second_gauss_area_coord =  NULL;
    3178         double* third_gauss_area_coord  =  NULL;
    3179         double* gauss_weights           =  NULL;
    3180         double  gauss_weight;
    3181         double  gauss_l1l2l3[3];
    3182 
    3183        
    3184         /* surface normal: */
    3185         double x4,y4,z4;
    3186         double x5,y5,z5;
    3187         double x6,y6,z6;
    3188         double v46[3];
    3189         double v56[3];
    3190         double normal[3];
    3191         double norm_normal;
    3192         double nz;
    3193 
    3194         /*Matrices: */
    3195         double DL_scalar;
    3196         double L[3];
    3197         double Jdet;
    3198 
    3199         /* local element matrices: */
    3200         double Ke_gg[numdof][numdof]; //local element stiffness matrix
    3201         double Ke_gg_gaussian[numdof][numdof]; //stiffness matrix evaluated at the gaussian point.
    3202 
    3203         ParameterInputs* inputs=NULL;
    3204 
    3205         /*recover pointers: */
    3206         inputs=(ParameterInputs*)vinputs;
    3207        
    3208         /* Get node coordinates and dof list: */
    3209         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    3210         GetDofList(&doflist[0],&numberofdofspernode);
    3211 
    3212         /* Set Ke_gg to 0: */
    3213         for(i=0;i<numdof;i++) for(j=0;j<numdof;j++) Ke_gg[i][j]=0.0;
    3214 
    3215         /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
    3216         GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
    3217 
    3218         /*Build normal vector to the surface:*/
    3219        
    3220         x4=xyz_list[0][0];
    3221         y4=xyz_list[0][1];
    3222         z4=xyz_list[0][2];
    3223 
    3224         x5=xyz_list[1][0];
    3225         y5=xyz_list[1][1];
    3226         z5=xyz_list[1][2];
    3227 
    3228         x6=xyz_list[2][0];
    3229         y6=xyz_list[2][1];
    3230         z6=xyz_list[2][2];
    3231 
    3232         v46[0]=x4-x6;
    3233         v46[1]=y4-y6;
    3234         v46[2]=z4-z6;
    3235 
    3236         v56[0]=x5-x6;
    3237         v56[1]=y5-y6;
    3238         v56[2]=z5-z6;
    3239 
    3240         normal[0]=(y4-y6)*(z5-z6)-(z4-z6)*(y5-y6);
    3241         normal[1]=(z4-z6)*(x5-x6)-(x4-x6)*(z5-z6);
    3242         normal[2]=(x4-x6)*(y5-y6)-(y4-y6)*(x5-x6);
    3243 
    3244         norm_normal=sqrt(pow(normal[0],(double)2)+pow(normal[1],(double)2)+pow(normal[2],(double)2));
    3245         nz=1.0/norm_normal*normal[2];
    3246 
    3247         /* Start  looping on the number of gaussian points: */
    3248         for (ig=0; ig<num_gauss; ig++){
    3249                 /*Pick up the gaussian point: */
    3250                 gauss_weight=*(gauss_weights+ig);
    3251                 gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
    3252                 gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
    3253                 gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
    3254 
    3255                 /* Get Jacobian determinant: */
    3256                 GetJacobianDeterminant3d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
    3257        
    3258                 //Get L matrix if viscous basal drag present:
    3259                 GetL(&L[0], &xyz_list[0][0], gauss_l1l2l3,NDOF1);
    3260 
    3261                 /**********************Do not forget the sign**********************************/
    3262                 DL_scalar=- gauss_weight*Jdet*nz;
    3263                 /******************************************************************************/
    3264        
    3265                 /*  Do the triple producte tL*D*L: */
    3266                 TripleMultiply( L,1,3,1,
    3267                                         &DL_scalar,1,1,0,
    3268                                         L,1,3,0,
    3269                                         &Ke_gg_gaussian[0][0],0);
    3270 
    3271                 /* Add the Ke_gg_gaussian, onto Ke_gg: */
    3272                 for( i=0; i<numdof; i++) for(j=0;j<numdof;j++) Ke_gg[i][j]+=Ke_gg_gaussian[i][j];
    3273 
    3274                
    3275         } //for (ig=0; ig<num_gauss; ig++)
    3276 
    3277         /*Add Ke_gg to global matrix Kgg: */
    3278         MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)Ke_gg,ADD_VALUES);
    3279        
    3280         cleanup_and_return:
    3281         xfree((void**)&first_gauss_area_coord);
    3282         xfree((void**)&second_gauss_area_coord);
    3283         xfree((void**)&third_gauss_area_coord);
    3284         xfree((void**)&gauss_weights);
    3285 }
    3286 /*}}}*/
    3287 /*FUNCTION CreatePVectorDiagnosticBaseVert {{{1*/
    3288 #undef __FUNCT__
    3289 #define __FUNCT__ "Tria::CreatePVectorDiagnosticBaseVert"
    3290 void  Tria::CreatePVectorDiagnosticBaseVert(Vec pg,void* vinputs,int analysis_type,int sub_analysis_type){
    3291 
    3292         int             i,j;
    3293 
    3294         /* node data: */
    3295         const int    numgrids=3;
    3296         const int    NDOF1=1;
    3297         const int    numdof=NDOF1*numgrids;
    3298         double       xyz_list[numgrids][3];
    3299         int          doflist[numdof];
    3300         int          numberofdofspernode;
    3301        
    3302         /* gaussian points: */
    3303         int     num_gauss,ig;
    3304         double* first_gauss_area_coord  =  NULL;
    3305         double* second_gauss_area_coord =  NULL;
    3306         double* third_gauss_area_coord  =  NULL;
    3307         double* gauss_weights           =  NULL;
    3308         double  gauss_weight;
    3309         double  gauss_l1l2l3[3];
    3310 
    3311         /* Jacobian: */
    3312         double Jdet;
    3313 
    3314         /*nodal functions: */
    3315         double l1l2l3[3];
    3316 
    3317         /*element vector at the gaussian points: */
    3318         double  pe_g[numdof];
    3319         double  pe_g_gaussian[numdof];
    3320 
    3321         /* matrices: */
    3322         double L[numgrids];
    3323 
    3324         /*input parameters for structural analysis (diagnostic): */
    3325         double* velocity_param=NULL;
    3326         double  vx_list[numgrids]={0,0,0};
    3327         double  vy_list[numgrids]={0,0,0};
    3328         double  vx,vy;
    3329         double  meltingvalue;
    3330         double  slope[2];
    3331         double  dbdx,dbdy;
    3332         int     dofs1[1]={0};
    3333         int     dofs2[1]={1};
    3334 
    3335         ParameterInputs* inputs=NULL;
    3336 
    3337         /*recover pointers: */
    3338         inputs=(ParameterInputs*)vinputs;
    3339 
    3340         /* recover input parameters: */
    3341         if(!inputs->Recover("velocity",&vx_list[0],1,dofs1,numgrids,(void**)nodes))throw ErrorException(__FUNCT__," cannot compute vertical velocity without horizontal velocity");
    3342             inputs->Recover("velocity",&vy_list[0],1,dofs2,numgrids,(void**)nodes);
    3343 
    3344         /* Get node coordinates and dof list: */
    3345         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    3346         GetDofList(&doflist[0],&numberofdofspernode);
    3347 
    3348         /* Set pe_g to 0: */
    3349         for(i=0;i<numdof;i++) pe_g[i]=0.0;
    3350 
    3351         /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
    3352         GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
    3353 
    3354         /*For icesheets: */
    3355         /* Start  looping on the number of gaussian points: */
    3356         for (ig=0; ig<num_gauss; ig++){
    3357 
    3358                 /*Pick up the gaussian point: */
    3359                 gauss_weight=*(gauss_weights+ig);
    3360                 gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
    3361                 gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
    3362                 gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
    3363 
    3364                 /*Get melting at gaussian point: */
    3365                 GetParameterValue(&meltingvalue, &melting[0],gauss_l1l2l3);
    3366 
    3367                 /*Get velocity at gaussian point: */
    3368                 GetParameterValue(&vx, &vx_list[0],gauss_l1l2l3);
    3369                 GetParameterValue(&vy, &vy_list[0],gauss_l1l2l3);
    3370 
    3371                 /*Get bed slope: */
    3372                 GetParameterDerivativeValue(&slope[0], &b[0],&xyz_list[0][0], gauss_l1l2l3);
    3373                 dbdx=slope[0];
    3374                 dbdy=slope[1];
    3375 
    3376                 /* Get Jacobian determinant: */
    3377                 GetJacobianDeterminant3d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
    3378                
    3379                 //Get L matrix if viscous basal drag present:
    3380                 GetL(&L[0], &xyz_list[0][0], gauss_l1l2l3,NDOF1);
    3381 
    3382                
    3383                 /*Build gaussian vector: */
    3384                 for(i=0;i<numgrids;i++){
    3385                         pe_g_gaussian[i]=-Jdet*gauss_weight*(vx*dbdx+vy*dbdy-meltingvalue)*L[i];
    3386                 }
    3387        
    3388                 /*Add pe_g_gaussian vector to pe_g: */
    3389                 for( i=0; i<numdof; i++)pe_g[i]+=pe_g_gaussian[i];
    3390        
    3391         }
    3392 
    3393         /*Add pe_g to global vector pg: */
    3394         VecSetValues(pg,numdof,doflist,(const double*)pe_g,ADD_VALUES);
    3395 
    3396         cleanup_and_return:
    3397         xfree((void**)&first_gauss_area_coord);
    3398         xfree((void**)&second_gauss_area_coord);
    3399         xfree((void**)&third_gauss_area_coord);
    3400         xfree((void**)&gauss_weights);
    3401 
    3402 }
    3403 /*}}}*/
    3404 /*FUNCTION ComputePressure {{{1*/
    3405 #undef __FUNCT__
    3406 #define __FUNCT__ "Tria::ComputePressure"
    3407 void  Tria::ComputePressure(Vec pg){
    3408 
    3409         int i;
    3410         const int numgrids=3;
    3411         int doflist[numgrids];
    3412         double pressure[numgrids];
    3413         double rho_ice,g;
    3414 
    3415         /*Get dof list on which we will plug the pressure values: */
    3416         GetDofList1(&doflist[0]);
    3417 
    3418         /*pressure is lithostatic: */
    3419         rho_ice=matpar->GetRhoIce();
    3420         g=matpar->GetG();
    3421         for(i=0;i<numgrids;i++){
    3422                 pressure[i]=rho_ice*g*h[i];
    3423         }
    3424        
    3425         /*plug local pressure values into global pressure vector: */
    3426         VecSetValues(pg,numgrids,doflist,(const double*)pressure,INSERT_VALUES);
    3427 
    3428 }
    3429 /*}}}*/
    3430 /*FUNCTION CreateKMatrixThermal {{{1*/
    3431 #undef __FUNCT__
    3432 #define __FUNCT__ "Tria::CreateKMatrixThermal"
    3433 void  Tria::CreateKMatrixThermal(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
    3434 
    3435         int i,j;
    3436         int found=0;
    3437        
    3438         /* node data: */
    3439         const int    numgrids=3;
    3440         const int    NDOF1=1;
    3441         const int    numdof=NDOF1*numgrids;
    3442         double       xyz_list[numgrids][3];
    3443         int          doflist[numdof];
    3444         int          numberofdofspernode;
    3445 
    3446         double mixed_layer_capacity;
    3447         double thermal_exchange_velocity;
    3448         double rho_water;
    3449         double rho_ice;
    3450         double heatcapacity;
    3451         double dt;
    3452 
    3453         int     num_gauss,ig;
    3454         double* first_gauss_area_coord  =  NULL;
    3455         double* second_gauss_area_coord =  NULL;
    3456         double* third_gauss_area_coord  =  NULL;
    3457         double* gauss_weights           =  NULL;
    3458         double  gauss_weight;
    3459         double  gauss_coord[3];
    3460 
    3461         /*matrices: */
    3462         double  Jdet;
    3463         double  K_terms[numdof][numdof]={0.0};
    3464         double  Ke_gaussian[numdof][numdof]={0.0};
    3465         double  l1l2l3[numgrids];
    3466         double     tl1l2l3D[3];
    3467         double  D_scalar;
    3468         ParameterInputs* inputs=NULL;
    3469 
    3470         /*recover pointers: */
    3471         inputs=(ParameterInputs*)vinputs;
    3472 
    3473         /*recover extra inputs from users, dt: */
    3474         found=inputs->Recover("dt",&dt);
    3475         if(!found)throw ErrorException(__FUNCT__," could not find dt in inputs!");
    3476 
    3477         /* Get node coordinates and dof list: */
    3478         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    3479         GetDofList(&doflist[0],&numberofdofspernode);
    3480 
    3481         //recover material parameters
    3482         mixed_layer_capacity=matpar->GetMixedLayerCapacity();
    3483         thermal_exchange_velocity=matpar->GetThermalExchangeVelocity();
    3484         rho_water=matpar->GetRhoWater();
    3485         rho_ice=matpar->GetRhoIce();
    3486         heatcapacity=matpar->GetHeatCapacity();
    3487 
    3488 
    3489         GaussTria (&num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
    3490 
    3491         /* Start looping on the number of gauss (nodes on the bedrock) */
    3492         for (ig=0; ig<num_gauss; ig++){
    3493                 gauss_weight=*(gauss_weights+ig);
    3494                 gauss_coord[0]=*(first_gauss_area_coord+ig);
    3495                 gauss_coord[1]=*(second_gauss_area_coord+ig);
    3496                 gauss_coord[2]=*(third_gauss_area_coord+ig);
    3497                
    3498                 //Get the Jacobian determinant
    3499                 GetJacobianDeterminant3d(&Jdet, &xyz_list[0][0], gauss_coord);
    3500                
    3501                 /*Get nodal functions values: */
    3502                 GetNodalFunctions(&l1l2l3[0], gauss_coord);
    3503                                
    3504                 /*Calculate DL on gauss point */
    3505                 D_scalar=gauss_weight*Jdet*rho_water*mixed_layer_capacity*thermal_exchange_velocity/(heatcapacity*rho_ice);
    3506                 if(dt){
    3507                         D_scalar=dt*D_scalar;
    3508                 }
    3509 
    3510                 /*  Do the triple product tL*D*L: */
    3511                 MatrixMultiply(&l1l2l3[0],numdof,1,0,&D_scalar,1,1,0,&tl1l2l3D[0],0);
    3512                 MatrixMultiply(&tl1l2l3D[0],numdof,1,0,&l1l2l3[0],1,numdof,0,&Ke_gaussian[0][0],0);
    3513 
    3514                 for(i=0;i<3;i++){
    3515                         for(j=0;j<3;j++){
    3516                                 K_terms[i][j]+=Ke_gaussian[i][j];
    3517                         }
    3518                 }
    3519         }
    3520        
    3521         /*Add Ke_gg to global matrix Kgg: */
    3522         MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)K_terms,ADD_VALUES);
    3523 
    3524         cleanup_and_return:
    3525         xfree((void**)&first_gauss_area_coord);
    3526         xfree((void**)&second_gauss_area_coord);
    3527         xfree((void**)&third_gauss_area_coord);
    3528         xfree((void**)&gauss_weights);
    3529 
    3530 }
    3531 /*}}}*/
    3532 /*FUNCTION CreateKMatrixMelting {{{1*/
    3533 #undef __FUNCT__
    3534 #define __FUNCT__ "Tria::CreateKMatrixMelting"
    3535 void  Tria::CreateKMatrixMelting(Mat Kgg,void* vinputs,int analysis_type,int sub_analysis_type){
    3536        
    3537         /*indexing: */
    3538         int i,j;
    3539 
    3540         const int  numgrids=3;
    3541         const int  NDOF1=1;
    3542         const int  numdof=numgrids*NDOF1;
    3543         int        doflist[numdof];
    3544         int        numberofdofspernode;
    3545 
    3546         /*Grid data: */
    3547         double     xyz_list[numgrids][3];
    3548                
    3549         /*Material constants */
    3550         double     heatcapacity,latentheat;
    3551 
    3552         /* gaussian points: */
    3553         int     num_area_gauss,ig;
    3554         double* gauss_weights  =  NULL;
    3555         double* first_gauss_area_coord  =  NULL;
    3556         double* second_gauss_area_coord =  NULL;
    3557         double* third_gauss_area_coord  =  NULL;
    3558         double  gauss_weight;
    3559         double  gauss_coord[3];
    3560 
    3561         /*matrices: */
    3562         double     Jdet;
    3563         double     D_scalar;
    3564         double     K_terms[numdof][numdof]={0.0};
    3565         double     L[3];
    3566         double     tLD[3];
    3567         double     Ke_gaussian[numdof][numdof]={0.0};
    3568 
    3569         /*Recover constants of ice */
    3570         latentheat=matpar->GetLatentHeat();
    3571         heatcapacity=matpar->GetHeatCapacity();
    3572 
    3573         /* Get node coordinates and dof list: */
    3574         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    3575         GetDofList(&doflist[0],&numberofdofspernode);
    3576 
    3577         /* Get gaussian points and weights: */
    3578         GaussTria (&num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
    3579 
    3580         /* Start looping on the number of gauss  (nodes on the bedrock) */
    3581         for (ig=0; ig<num_area_gauss; ig++){
    3582                 gauss_weight=*(gauss_weights+ig);
    3583                 gauss_coord[0]=*(first_gauss_area_coord+ig);
    3584                 gauss_coord[1]=*(second_gauss_area_coord+ig);
    3585                 gauss_coord[2]=*(third_gauss_area_coord+ig);
    3586                
    3587                 //Get the Jacobian determinant
    3588                 GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0], gauss_coord);
    3589                
    3590                 /*Get L matrix : */
    3591                 GetL(&L[0], &xyz_list[0][0], gauss_coord,NDOF1);
    3592                                
    3593                 /*Calculate DL on gauss point */
    3594                 D_scalar=latentheat/heatcapacity*gauss_weight*Jdet;
    3595 
    3596                 /*  Do the triple product tL*D*L: */
    3597                 MatrixMultiply(&L[0],numdof,1,0,&D_scalar,1,1,0,&tLD[0],0);
    3598                 MatrixMultiply(&tLD[0],numdof,1,0,&L[0],1,numdof,0,&Ke_gaussian[0][0],0);
    3599 
    3600                 for(i=0;i<numgrids;i++){
    3601                         for(j=0;j<numgrids;j++){
    3602                         K_terms[i][j]+=Ke_gaussian[i][j];
    3603                         }
    3604                 }
    3605         }
    3606        
    3607         /*Add Ke_gg to global matrix Kgg: */
    3608         MatSetValues(Kgg,numdof,doflist,numdof,doflist,(const double*)K_terms,ADD_VALUES);
    3609 
    3610         cleanup_and_return:
    3611         xfree((void**)&first_gauss_area_coord);
    3612         xfree((void**)&second_gauss_area_coord);
    3613         xfree((void**)&third_gauss_area_coord);
    3614         xfree((void**)&gauss_weights);
    3615 
    3616 }
    3617 /*}}}*/
    3618 /*FUNCTION CreatePVectorThermalShelf {{{1*/
    3619 #undef __FUNCT__
    3620 #define __FUNCT__ "Tria::CreatePVectorThermalShelf"
    3621 void Tria::CreatePVectorThermalShelf( Vec pg, void* vinputs, int analysis_type,int sub_analysis_type){
    3622 
    3623         int i,found;
    3624        
    3625         const int  numgrids=3;
    3626         const int  NDOF1=1;
    3627         const int  numdof=numgrids*NDOF1;
    3628         int        doflist[numdof];
    3629         int        numberofdofspernode;
    3630         double       xyz_list[numgrids][3];
    3631 
    3632         double mixed_layer_capacity;
    3633         double thermal_exchange_velocity;
    3634         double rho_water;
    3635         double rho_ice;
    3636         double heatcapacity;
    3637         double beta;
    3638         double meltingpoint;
    3639 
    3640         /*inputs: */
    3641         double dt;
    3642         double pressure_list[3];
    3643         double pressure;
    3644 
    3645         /* gaussian points: */
    3646         int     num_area_gauss,ig;
    3647         double* gauss_weights  =  NULL;
    3648         double* first_gauss_area_coord  =  NULL;
    3649         double* second_gauss_area_coord =  NULL;
    3650         double* third_gauss_area_coord  =  NULL;
    3651         double  gauss_weight;
    3652         double  gauss_coord[3];
    3653         int     dofs1[1]={0};
    3654 
    3655         /*matrices: */
    3656         double  Jdet;
    3657         double  P_terms[numdof]={0.0};
    3658         double  l1l2l3[numgrids];
    3659 
    3660         double  t_pmp;
    3661         double  scalar_ocean;
    3662 
    3663         ParameterInputs* inputs=NULL;
    3664 
    3665         /*recover pointers: */
    3666         inputs=(ParameterInputs*)vinputs;
    3667        
    3668         /* Get node coordinates and dof list: */
    3669         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    3670         GetDofList(&doflist[0],&numberofdofspernode);
    3671 
    3672         //recover material parameters
    3673         mixed_layer_capacity=matpar->GetMixedLayerCapacity();
    3674         thermal_exchange_velocity=matpar->GetThermalExchangeVelocity();
    3675         rho_water=matpar->GetRhoWater();
    3676         rho_ice=matpar->GetRhoIce();
    3677         heatcapacity=matpar->GetHeatCapacity();
    3678         beta=matpar->GetBeta();
    3679         meltingpoint=matpar->GetMeltingPoint();
    3680 
    3681 
    3682         /*recover extra inputs from users, dt and velocity: */
    3683         found=inputs->Recover("dt",&dt);
    3684         if(!found)throw ErrorException(__FUNCT__," could not find dt in inputs!");
    3685         found=inputs->Recover("pressure",&pressure_list[0],1,dofs1,numgrids,(void**)nodes);
    3686         if(!found)throw ErrorException(__FUNCT__," could not find pressure in inputs!");
    3687 
    3688         /* Ice/ocean heat exchange flux on ice shelf base */
    3689 
    3690         GaussTria (&num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
    3691 
    3692         /* Start looping on the number of gauss 2d (nodes on the bedrock) */
    3693         for (ig=0; ig<num_area_gauss; ig++){
    3694                 gauss_weight=*(gauss_weights+ig);
    3695                 gauss_coord[0]=*(first_gauss_area_coord+ig);
    3696                 gauss_coord[1]=*(second_gauss_area_coord+ig);
    3697                 gauss_coord[2]=*(third_gauss_area_coord+ig);
    3698 
    3699                 //Get the Jacobian determinant
    3700                 GetJacobianDeterminant3d(&Jdet, &xyz_list[0][0], gauss_coord);
    3701 
    3702                 /*Get nodal functions values: */
    3703                 GetNodalFunctions(&l1l2l3[0], gauss_coord);
    3704 
    3705                 /*Get geothermal flux and basal friction */
    3706                 GetParameterValue(&pressure,&pressure_list[0],gauss_coord);
    3707                 t_pmp=meltingpoint-beta*pressure;
    3708 
    3709                 /*Calculate scalar parameter*/
    3710                 scalar_ocean=gauss_weight*Jdet*rho_water*mixed_layer_capacity*thermal_exchange_velocity*(t_pmp)/(heatcapacity*rho_ice);
    3711                 if(dt){
    3712                         scalar_ocean=dt*scalar_ocean;
    3713                 }
    3714 
    3715                 for(i=0;i<3;i++){
    3716                         P_terms[i]+=scalar_ocean*l1l2l3[i];
    3717                 }
    3718         }
    3719 
    3720         /*Add pe_g to global vector pg: */
    3721         VecSetValues(pg,numdof,doflist,(const double*)P_terms,ADD_VALUES);
    3722 
    3723         cleanup_and_return:
    3724         xfree((void**)&first_gauss_area_coord);
    3725         xfree((void**)&second_gauss_area_coord);
    3726         xfree((void**)&third_gauss_area_coord);
    3727         xfree((void**)&gauss_weights);
    3728 
    3729 }
    3730 /*}}}*/
    3731 /*FUNCTION CreatePVectorThermalSheet {{{1*/
    3732 #undef __FUNCT__
    3733 #define __FUNCT__ "Tria::CreatePVectorThermalSheet"
    3734 void Tria::CreatePVectorThermalSheet( Vec pg, void* vinputs, int analysis_type,int sub_analysis_type){
    3735 
    3736         int i,found;
    3737        
    3738         const int  numgrids=3;
    3739         const int  NDOF1=1;
    3740         const int  numdof=numgrids*NDOF1;
    3741         int        doflist[numdof];
    3742         int        numberofdofspernode;
    3743         double       xyz_list[numgrids][3];
    3744         double     vxvyvz_list[numgrids][3];
    3745         double     vx_list[numgrids];
    3746         double     vy_list[numgrids];
    3747 
    3748         double rho_ice;
    3749         double heatcapacity;
    3750 
    3751         /*inputs: */
    3752         double dt;
    3753         double pressure_list[3];
    3754         double pressure;
    3755         double alpha2_list[3];
    3756         double basalfriction_list[3];
    3757         double basalfriction;
    3758         double geothermalflux_value;
    3759 
    3760         /* gaussian points: */
    3761         int     num_area_gauss,ig;
    3762         double* gauss_weights  =  NULL;
    3763         double* first_gauss_area_coord  =  NULL;
    3764         double* second_gauss_area_coord =  NULL;
    3765         double* third_gauss_area_coord  =  NULL;
    3766         double  gauss_weight;
    3767         double  gauss_coord[3];
    3768         int     dofs1[1]={0};
    3769 
    3770         /*matrices: */
    3771         double  Jdet;
    3772         double  P_terms[numdof]={0.0};
    3773         double  l1l2l3[numgrids];
    3774         double  scalar;
    3775 
    3776         int     dofs[3]={0,1,2};
    3777 
    3778         ParameterInputs* inputs=NULL;
    3779 
    3780         /*recover pointers: */
    3781         inputs=(ParameterInputs*)vinputs;
    3782        
    3783         /* Get node coordinates and dof list: */
    3784         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    3785         GetDofList(&doflist[0],&numberofdofspernode);
    3786 
    3787         //recover material parameters
    3788         rho_ice=matpar->GetRhoIce();
    3789         heatcapacity=matpar->GetHeatCapacity();
    3790 
    3791 
    3792         /*recover extra inputs from users, dt and velocity: */
    3793         found=inputs->Recover("dt",&dt);
    3794         if(!found)throw ErrorException(__FUNCT__," could not find dt in inputs!");
    3795        
    3796         found=inputs->Recover("velocity",&vxvyvz_list[0][0],3,dofs,numgrids,(void**)nodes);
    3797         if(!found)throw ErrorException(__FUNCT__," could not find velocity in inputs!");
    3798 
    3799         for(i=0;i<numgrids;i++){
    3800                 vx_list[i]=vxvyvz_list[i][0];
    3801                 vy_list[i]=vxvyvz_list[i][1];
    3802         }       
    3803 
    3804         /*Build alpha2_list used by drag stiffness matrix*/
    3805         Friction* friction=NewFriction();
    3806        
    3807         /*Initialize all fields: */
    3808         if (friction_type!=2)throw ErrorException(__FUNCT__," non-viscous friction not supported yet!");
    3809        
    3810         friction->element_type=(char*)xmalloc((strlen("3d")+1)*sizeof(char));
    3811         strcpy(friction->element_type,"3d");
    3812        
    3813         friction->gravity=matpar->GetG();
    3814         friction->rho_ice=matpar->GetRhoIce();
    3815         friction->rho_water=matpar->GetRhoWater();
    3816         friction->K=&k[0];
    3817         friction->bed=&b[0];
    3818         friction->thickness=&h[0];
    3819         friction->velocities=&vxvyvz_list[0][0];
    3820         friction->p=p;
    3821         friction->q=q;
    3822 
    3823         /*Compute alpha2_list: */
    3824         FrictionGetAlpha2(&alpha2_list[0],friction);
    3825 
    3826         /*Erase friction object: */
    3827         DeleteFriction(&friction);
    3828 
    3829         /* Compute basal friction */
    3830         for(i=0;i<numgrids;i++){
    3831                 basalfriction_list[i]= alpha2_list[i]*(pow(vx_list[i],(double)2.0)+pow(vy_list[i],(double)2.0));
    3832         }
    3833        
    3834         /* Ice/ocean heat exchange flux on ice shelf base */
    3835         GaussTria (&num_area_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
    3836 
    3837         /* Start looping on the number of gauss 2d (nodes on the bedrock) */
    3838         for (ig=0; ig<num_area_gauss; ig++){
    3839                 gauss_weight=*(gauss_weights+ig);
    3840                 gauss_coord[0]=*(first_gauss_area_coord+ig);
    3841                 gauss_coord[1]=*(second_gauss_area_coord+ig);
    3842                 gauss_coord[2]=*(third_gauss_area_coord+ig);
    3843 
    3844                 //Get the Jacobian determinant
    3845                 GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0], gauss_coord);
    3846 
    3847                 /*Get nodal functions values: */
    3848                 GetNodalFunctions(&l1l2l3[0], gauss_coord);
    3849 
    3850                 /*Get geothermal flux and basal friction */
    3851                 GetParameterValue(&geothermalflux_value,&geothermalflux[0],gauss_coord);
    3852                 GetParameterValue(&basalfriction,&basalfriction_list[0],gauss_coord);
    3853 
    3854                 /*Calculate scalar parameter*/
    3855                 scalar=gauss_weight*Jdet*(basalfriction+geothermalflux_value)/(heatcapacity*rho_ice);
    3856                 if(dt){
    3857                         scalar=dt*scalar;
    3858                 }
    3859 
    3860                 for(i=0;i<3;i++){
    3861                         P_terms[i]+=scalar*l1l2l3[i];
    3862                 }
    3863         }
    3864 
    3865         /*Add pe_g to global vector pg: */
    3866         VecSetValues(pg,numdof,doflist,(const double*)P_terms,ADD_VALUES);
    3867 
    3868         cleanup_and_return:
    3869         xfree((void**)&first_gauss_area_coord);
    3870         xfree((void**)&second_gauss_area_coord);
    3871         xfree((void**)&third_gauss_area_coord);
    3872         xfree((void**)&gauss_weights);
    3873 
    3874 }
    3875 /*}}}*/
    38763614/*FUNCTION MassFlux {{{1*/
    38773615#undef __FUNCT__
    … …  
    38973635        double vx1,vx2,vy1,vy2;
    38983636        double rho_ice;
    3899        
     3637
    39003638        /*Get material parameters :*/
    39013639        rho_ice=this->matpar->GetRhoIce();
    … …  
    39063644        /*Recover segment node locations: */
    39073645        x1=*(segment+0); y1=*(segment+1); x2=*(segment+2); y2=*(segment+3);
    3908        
     3646
    39093647        /*Get xyz list: */
    39103648        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    … …  
    39403678
    39413679        mass_flux= rho_ice*length*( 
    3942                                   (1.0/3.0*(h1-h2)*(vx1-vx2)+1.0/2.0*h2*(vx1-vx2)+1.0/2.0*(h1-h2)*vx2+h2*vx2)*normal[0]+
    3943                                   (1.0/3.0*(h1-h2)*(vy1-vy2)+1.0/2.0*h2*(vy1-vy2)+1.0/2.0*(h1-h2)*vy2+h2*vy2)*normal[1]
     3680                                (1.0/3.0*(h1-h2)*(vx1-vx2)+1.0/2.0*h2*(vx1-vx2)+1.0/2.0*(h1-h2)*vx2+h2*vx2)*normal[0]+
     3681                                (1.0/3.0*(h1-h2)*(vy1-vy2)+1.0/2.0*h2*(vy1-vy2)+1.0/2.0*(h1-h2)*vy2+h2*vy2)*normal[1]
    39443682                                );
    39453683        return mass_flux;
    39463684}
    39473685/*}}}*/
    3948 /*FUNCTION GetArea {{{1*/
    3949 #undef __FUNCT__
    3950 #define __FUNCT__ "Tria::GetArea"
    3951 double Tria::GetArea(void){
    3952 
    3953         double area=0;
     3686/*FUNCTION MaticeConfiguration {{{1*/
     3687#undef __FUNCT__
     3688#define __FUNCT__ "Tria::MaticeConfiguration"
     3689void  Tria::MaticeConfiguration(Matice* tria_matice,int tria_matice_offset){
     3690           matice=tria_matice;
     3691                   matice_offset=tria_matice_offset;
     3692}
     3693/*}}}*/
     3694/*FUNCTION MatparConfiguration {{{1*/
     3695#undef __FUNCT__
     3696#define __FUNCT__ "Tria::MatparConfiguration"
     3697void  Tria::MatparConfiguration(Matpar* tria_matpar,int tria_matpar_offset){
     3698
     3699           matpar=tria_matpar;
     3700                   matpar_offset=tria_matpar_offset;
     3701
     3702}
     3703/*}}}*/
     3704/*FUNCTION Misfit {{{1*/
     3705#undef __FUNCT__
     3706#define __FUNCT__ "Tria::Misfit"
     3707double Tria::Misfit(void* vinputs,int analysis_type,int sub_analysis_type){
     3708
     3709        int i;
     3710
     3711        /* output: */
     3712        double Jelem=0;
     3713
     3714        /* node data: */
    39543715        const int    numgrids=3;
    3955         double xyz_list[numgrids][3];
    3956         double x1,y1,x2,y2,x3,y3;
    3957 
    3958         /*Get xyz list: */
     3716        const int    numdof=2*numgrids;
     3717        const int    NDOF2=2;
     3718        int          dofs1[1]={0};
     3719        int          dofs2[2]={0,1};
     3720        double       xyz_list[numgrids][3];
     3721
     3722        /* grid data: */
     3723        double vxvy_list[numgrids][2];
     3724        double vx_list[numgrids];
     3725        double vy_list[numgrids];
     3726        double obs_vxvy_list[numgrids][2];
     3727        double obs_vx_list[numgrids];
     3728        double obs_vy_list[numgrids];
     3729        double absolute_list[numgrids];
     3730        double relative_list[numgrids];
     3731        double logarithmic_list[numgrids];
     3732        double B[numgrids];
     3733
     3734        /* gaussian points: */
     3735        int     num_gauss,ig;
     3736        double* first_gauss_area_coord  =  NULL;
     3737        double* second_gauss_area_coord =  NULL;
     3738        double* third_gauss_area_coord  =  NULL;
     3739        double* gauss_weights           =  NULL;
     3740        double  gauss_weight;
     3741        double  gauss_l1l2l3[3];
     3742        double  k_gauss;
     3743        double  B_gauss;
     3744
     3745        /* parameters: */
     3746        double  velocity_mag,obs_velocity_mag;
     3747        double  absolute,relative,logarithmic;
     3748        double  dk[NDOF2];
     3749        double  dB[NDOF2];
     3750
     3751        /* Jacobian: */
     3752        double Jdet;
     3753
     3754        /*relative and logarithmic control method :*/
     3755        double scalex=1;
     3756        double scaley=1;
     3757        double  fit=-1;
     3758
     3759        ParameterInputs* inputs=NULL;
     3760
     3761        /*If on water, return 0: */
     3762        if(onwater)return 0;
     3763
     3764        /*recover pointers: */
     3765        inputs=(ParameterInputs*)vinputs;
     3766
     3767        /* Get node coordinates and dof list: */
    39593768        GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    3960         x1=xyz_list[0][0]; y1=xyz_list[0][1];
    3961         x2=xyz_list[1][0]; y2=xyz_list[1][1];
    3962         x3=xyz_list[2][0]; y3=xyz_list[2][1];
    3963  
    3964         return x2*y3 - y2*x3 + x1*y2 - y1*x2 + x3*y1 - y3*x1;
    3965 }
    3966 /*}}}*/
    3967 /*FUNCTION GetAreaCoordinate {{{1*/
    3968 #undef __FUNCT__
    3969 #define __FUNCT__ "Tria::GetAreaCoordinate"
    3970 double Tria::GetAreaCoordinate(double x, double y, int which_one){
    3971 
    3972         double area=0;
    3973         const int    numgrids=3;
    3974         double xyz_list[numgrids][3];
    3975         double x1,y1,x2,y2,x3,y3;
    3976 
    3977         /*Get area: */
    3978         area=this->GetArea();
    3979 
    3980         /*Get xyz list: */
    3981         GetElementNodeData( &xyz_list[0][0], nodes, numgrids);
    3982         x1=xyz_list[0][0]; y1=xyz_list[0][1];
    3983         x2=xyz_list[1][0]; y2=xyz_list[1][1];
    3984         x3=xyz_list[2][0]; y3=xyz_list[2][1];
    3985 
    3986         if(which_one==1){
    3987                 /*Get first area coordinate = det(x-x3  x2-x3 ; y-y3   y2-y3)/area*/
    3988                 return ((x-x3)*(y2-y3)-(x2-x3)*(y-y3))/area;
    3989         }
    3990         else if(which_one==2){
    3991                 /*Get second area coordinate = det(x1-x3  x-x3 ; y1-y3   y-y3)/area*/
    3992                 return ((x1-x3)*(y-y3)-(x-x3)*(y1-y3))/area;
    3993         }
    3994         else if(which_one==3){
    3995                 /*Get third  area coordinate 1-area1-area2: */
    3996                 return 1-((x-x3)*(y2-y3)-(x2-x3)*(y-y3))/area -((x1-x3)*(y-y3)-(x-x3)*(y1-y3))/area;
    3997         }
    3998         else throw ErrorException(__FUNCT__,exprintf("%s%i%s\n"," error message: area coordinate ",which_one," done not exist!"));
    3999 }
    4000 /*}}}*/
     3769
     3770        /* Recover input data: */
     3771        if(!inputs->Recover("fit",&fit)) throw ErrorException(__FUNCT__," missing fit input parameter");
     3772        if(!inputs->Recover("velocity_obs",&obs_vxvy_list[0][0],2,dofs2,numgrids,(void**)nodes)){
     3773                throw ErrorException(__FUNCT__,"missing velocity_obs input parameter");
     3774        }
     3775        if(!inputs->Recover("velocity",&vxvy_list[0][0],2,dofs2,numgrids,(void**)nodes)){
     3776                throw ErrorException(__FUNCT__,"missing velocity input parameter");
     3777        }
     3778
     3779        /*Initialize velocities: */
     3780        for(i=0;i<numgrids;i++){
     3781                obs_vx_list[i]=obs_vxvy_list[i][0];
     3782                obs_vy_list[i]=obs_vxvy_list[i][1];
     3783                vx_list[i]=vxvy_list[i][0];
     3784                vy_list[i]=vxvy_list[i][1];
     3785        }
     3786
     3787        /*Compute Misfit at the 3 nodes (integration of the linearized function)*/
     3788        if(fit==0){
     3789                /*We are using an absolute misfit: */
     3790                for (i=0;i<numgrids;i++){
     3791                        absolute_list[i]=0.5*(pow((vx_list[i]-obs_vx_list[i]),(double)2)+pow((vy_list[i]-obs_vy_list[i]),(double)2));
     3792                }
     3793        }
     3794        else if(fit==1){
     3795                /*We are using a relative misfit: */
     3796                for (i=0;i<numgrids;i++){
     3797                        scalex=pow(numpar->meanvel/(obs_vx_list[i]+numpar->epsvel),(double)2);
     3798                        scaley=pow(numpar->meanvel/(obs_vy_list[i]+numpar->epsvel),(double)2);
     3799                        if(obs_vx_list[i]==0)scalex=0;
     3800                        if(obs_vy_list[i]==0)scaley=0;
     3801                        relative_list[i]=0.5*(scalex*pow((vx_list[i]-obs_vx_list[i]),2)+scaley*pow((vy_list[i]-obs_vy_list[i]),2));
     3802                }
     3803        }
     3804        else if(fit==2){
     3805                /*We are using a logarithmic misfit: */
     3806                for (i=0;i<numgrids;i++){
     3807                        velocity_mag=sqrt(pow(vx_list[i],(double)2)+pow(vy_list[i],(double)2))+numpar->epsvel; //epsvel to avoid velocity being nil.
     3808                        obs_velocity_mag=sqrt(pow(obs_vx_list[i],(double)2)+pow(obs_vy_list[i],(double)2))+numpar->epsvel; //epsvel to avoid observed velocity being nil.
     3809                        logarithmic_list[i]=4*pow(numpar->meanvel,(double)2)*pow(log(velocity_mag/obs_velocity_mag),(double)2);
     3810                }
     3811        }
     3812        else{
     3813                /*Not supported yet! : */
     3814                throw ErrorException(__FUNCT__,exprintf("%s%g","unsupported type of fit: ",fit));
     3815        }
     3816
     3817        /* Get gaussian points and weights (make this a statically initialized list of points? fstd): */
     3818        GaussTria( &num_gauss, &first_gauss_area_coord, &second_gauss_area_coord, &third_gauss_area_coord, &gauss_weights, 2);
     3819
     3820#ifdef _ISSM_DEBUG_
     3821        for (i=0;i<num_gauss;i++){
     3822                printf("Gauss coord %i: %lf %lf %lf Weight: %lf\n",i,*(first_gauss_area_coord+i),*(second_gauss_area_coord+i),*(third_gauss_area_coord+i),*(gauss_weights+i));
     3823        }
     3824#endif
     3825
     3826        /* Start  looping on the number of gaussian points: */
     3827        for (ig=0; ig<num_gauss; ig++){
     3828                /*Pick up the gaussian point: */
     3829                gauss_weight=*(gauss_weights+ig);
     3830                gauss_l1l2l3[0]=*(first_gauss_area_coord+ig);
     3831                gauss_l1l2l3[1]=*(second_gauss_area_coord+ig);
     3832                gauss_l1l2l3[2]=*(third_gauss_area_coord+ig);
     3833
     3834                /* Get Jacobian determinant: */
     3835                GetJacobianDeterminant2d(&Jdet, &xyz_list[0][0],gauss_l1l2l3);
     3836#ifdef _ISSM_DEBUG_
     3837                printf("Element id %i Jacobian determinant: %lf\n",GetId(),Jdet);
     3838#endif
     3839
     3840                /*Add dampening terms to misfit*/
     3841                if (strcmp(numpar->control_type,"drag")==0){
     3842                        if (!shelf){
     3843
     3844                                //noise dampening
     3845                                GetParameterDerivativeValue(&dk[0], &k[0],&xyz_list[0][0], gauss_l1l2l3);
     3846                                Jelem+=numpar->cm_noisedmp*1/2*(pow(dk[0],2)+pow(dk[1],2))*Jdet*gauss_weight;
     3847
     3848                        }
     3849                }
     3850                else if (strcmp(numpar->control_type,"B")==0){
     3851                        if(!inputs->Recover("B",&B[0],1,dofs1,numgrids,(void**)nodes)){
     3852                                throw ErrorException(__FUNCT__,"parameter B not found in input");
     3853                        }
     3854                        //noise dampening
     3855                        GetParameterDerivativeValue(&dB[0], &B[0],&xyz_list[0][0], gauss_l1l2l3);
     3856                        Jelem+=numpar->cm_noisedmp*1/2*(pow(dB[0],2)+pow(dB[1],2))*Jdet*gauss_weight;
     3857
     3858                        //min dampening
     3859                        GetParameterValue(&B_gauss, &B[0],gauss_l1l2l3);
     3860                        if(B_gauss<numpar->cm_mindmp_value){
     3861                                Jelem+=numpar->cm_mindmp_slope*B_gauss*Jdet*gauss_weight;
     3862                        }
     3863
     3864                        //max dampening
     3865                        if(B_gauss>numpar->cm_maxdmp_value){
     3866                                Jelem+=numpar->cm_maxdmp_slope*B_gauss*Jdet*gauss_weight;
     3867                        }
     3868                }
     3869                else{
     3870                        throw ErrorException(__FUNCT__,exprintf("%s%s","unsupported control type: ",numpar->control_type));
     3871                }
     3872
     3873                /*Differents misfits are allowed: */
     3874                if(fit==0){
     3875                        /*Compute absolute misfit at gaussian point: */
     3876                        GetParameterValue(&absolute, &absolute_list[0],gauss_l1l2l3);
     3877
     3878                        /*compute Misfit*/
     3879                        Jelem+=absolute*Jdet*gauss_weight;
     3880                }
     3881                else if(fit==1){
     3882                        /*Compute relative misfit at gaussian point: */
     3883                        GetParameterValue(&relative, &relative_list[0],gauss_l1l2l3);
     3884
     3885                        /*compute Misfit*/
     3886                        Jelem+=relative*Jdet*gauss_weight;
     3887                }       
     3888                else if(fit==2){
     3889                        /*Compute logarithmic misfit at gaussian point: */
     3890                        GetParameterValue(&logarithmic, &logarithmic_list[0],gauss_l1l2l3);
     3891
     3892                        /*compute Misfit*/
     3893                        Jelem+=logarithmic*Jdet*gauss_weight;
     3894                }
     3895                else throw ErrorException(__FUNCT__,exprintf("%s%i%s","fit type",fit," not supported yet!"));
     3896
     3897        }
     3898cleanup_and_return:
     3899        xfree((void**)&first_gauss_area_coord);
     3900        xfree((void**)&second_gauss_area_coord);
     3901        xfree((void**)&third_gauss_area_coord);
     3902        xfree((void**)&gauss_weights);
     3903
     3904        /*Return: */
     3905        return Jelem;
     3906}
     3907/*}}}*/
     3908/*FUNCTION MyRank {{{1*/
     3909int    Tria::MyRank(void){
     3910        extern int my_rank;
     3911        return my_rank;
     3912}
     3913/*}}}*/
     3914/*FUNCTION NodeConfiguration {{{1*/
     3915#undef __FUNCT__
     3916#define __FUNCT__ "Tria::NodeConfiguration"
     3917void  Tria::NodeConfiguration(int* tria_node_ids,Node* tria_nodes[3],int* tria_node_offsets){
     3918
     3919        int i;
     3920        for(i=0;i<3;i++){
     3921                node_ids[i]=tria_node_ids[i];
     3922                nodes[i]=tria_nodes[i];
     3923                node_offsets[i]=tria_node_offsets[i];
     3924        }
     3925
     3926}
     3927/*}}}*/
     3928/*FUNCTION NumparConfiguration {{{1*/
     3929#undef __FUNCT__
     3930#define __FUNCT__ "Tria::NumparConfiguration"
     3931void  Tria::NumparConfiguration(Numpar* tria_numpar,int tria_numpar_offset){
     3932
     3933        numpar=tria_numpar;
     3934        numpar_offset=tria_numpar_offset;
     3935
     3936}
     3937/*}}}*/
     3938/*FUNCTION SurfaceNormal{{{1*/
     3939#undef __FUNCT__
     3940#define __FUNCT__ "Tria::SurfaceNormal"
     3941
     3942void Tria::SurfaceNormal(double* surface_normal, double xyz_list[3][3]){
     3943
     3944        int i;
     3945        double v13[3];
     3946        double v23[3];
     3947        double normal[3];
     3948        double normal_norm;
     3949
     3950        for (i=0;i<3;i++){
     3951                v13[i]=xyz_list[0][i]-xyz_list[2][i];
     3952                v23[i]=xyz_list[1][i]-xyz_list[2][i];
     3953        }
     3954
     3955        normal[0]=v13[1]*v23[2]-v13[2]*v23[1];
     3956        normal[1]=v13[2]*v23[0]-v13[0]*v23[2];
     3957        normal[2]=v13[0]*v23[1]-v13[1]*v23[0];
     3958
     3959        normal_norm=sqrt( pow(normal[0],(double)2)+pow(normal[1],(double)2)+pow(normal[2],(double)2) );
     3960
     3961        *(surface_normal)=normal[0]/normal_norm;
     3962        *(surface_normal+1)=normal[1]/normal_norm;
     3963        *(surface_normal+2)=normal[2]/normal_norm;
     3964
     3965}
     3966/*}}}*/
     3967/*FUNCTION UpdateFromInputs {{{1*/
     3968#undef __FUNCT__
     3969#define __FUNCT__ "Tria::UpdateFromInputs"
     3970void  Tria::UpdateFromInputs(void* vinputs){
     3971
     3972        int     dofs[1]={0};
     3973        double  temperature_list[3];
     3974        double  temperature_average;
     3975        double  B_list[3];
     3976        double  B_average;
     3977
     3978        ParameterInputs* inputs=NULL;
     3979
     3980        /*recover pointers: */
     3981        inputs=(ParameterInputs*)vinputs;
     3982
     3983        /*Update internal data if inputs holds new values: */
     3984        inputs->Recover("thickness",&h[0],1,dofs,3,(void**)nodes);
     3985        inputs->Recover("surface",&s[0],1,dofs,3,(void**)nodes);
     3986        inputs->Recover("bed",&b[0],1,dofs,3,(void**)nodes);
     3987        inputs->Recover("drag",&k[0],1,dofs,3,(void**)nodes);
     3988        inputs->Recover("melting",&melting[0],1,dofs,3,(void**)nodes);
     3989        inputs->Recover("accumulation",&accumulation[0],1,dofs,3,(void**)nodes);
     3990        inputs->Recover("geothermalflux",&geothermalflux[0],1,dofs,3,(void**)nodes);
     3991       
     3992        //Update material if necessary
     3993        if(inputs->Recover("temperature_average",&temperature_list[0],1,dofs,3,(void**)nodes)){
     3994                temperature_average=(temperature_list[0]+temperature_list[1]+temperature_list[2])/3.0;
     3995                B_average=Paterson(temperature_average);
     3996                matice->SetB(B_average);
     3997        }
     3998       
     3999        if(inputs->Recover("B",&B_list[0],1,dofs,3,(void**)nodes)){
     4000                B_average=(B_list[0]+B_list[1]+B_list[2])/3.0;
     4001                matice->SetB(B_average);
     4002        }
     4003
     4004}
     4005/*}}}*/
Note: See TracChangeset for help on using the changeset viewer.