New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13027 for vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modbcfunction.F90 – NEMO

Ignore:
Timestamp:
2020-06-03T16:36:09+02:00 (4 years ago)
Author:
rblod
Message:

New AGRIF library, see ticket #2129

File:
1 edited

Legend:

Unmodified
Added
Removed

  • vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modbcfunction.F90

    r5656 r13027  
    5353!> To set the TYPE of the variable 
    5454!--------------------------------------------------------------------------------------------------- 
    55 subroutine Agrif_Set_parent_int(tabvarsindic,value) 
    56 !--------------------------------------------------------------------------------------------------- 
    57     integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars 
     55subroutine Agrif_Set_parent_int(integer_variable,value) 
     56!--------------------------------------------------------------------------------------------------- 
     57    integer, intent(in)     :: integer_variable !< indice of the variable in tabvars 
    5858    integer, intent(in)     :: value        !< input value 
    5959! 
    60     Agrif_Curgrid % parent % tabvars_i(tabvarsindic) % iarray0 = value 
     60     
     61integer :: i 
     62logical :: i_found 
     63 
     64i_found = .FALSE. 
     65 
     66do i=1,Agrif_NbVariables(4) 
     67  if (LOC(integer_variable) == LOC(agrif_curgrid%tabvars_i(i)%iarray0)) then 
     68     agrif_curgrid%tabvars_i(i)%parent_var%iarray0 = value 
     69     i_found = .TRUE. 
     70     EXIT 
     71  endif 
     72enddo 
     73 
     74if (.NOT.i_found) STOP 'Agrif_Set_Integer : Variable not found' 
     75 
    6176!--------------------------------------------------------------------------------------------------- 
    6277end subroutine Agrif_Set_parent_int 
    … …  
    6681!  subroutine Agrif_Set_parent_real4 
    6782!--------------------------------------------------------------------------------------------------- 
    68 !> To set the TYPE of the variable 
    69 !--------------------------------------------------------------------------------------------------- 
    70 subroutine Agrif_Set_parent_real4 ( tabvarsindic, value ) 
    71 !--------------------------------------------------------------------------------------------------- 
    72     integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars 
    73     real(kind=4),intent(in) :: value        !< input value 
    74 ! 
    75     Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % array0 = value 
    76     Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % sarray0 = value 
     83!> To set the parent value of a real variable 
     84!--------------------------------------------------------------------------------------------------- 
     85subroutine Agrif_Set_parent_real4 ( real_variable, value ) 
     86!--------------------------------------------------------------------------------------------------- 
     87    real(kind=4), intent(in)     :: real_variable !< input variable 
     88    real(kind=4),intent(in) :: value        !< input value for the parent grid 
     89 
     90integer :: i 
     91logical :: i_found 
     92 
     93i_found = .FALSE. 
     94 
     95do i=1,Agrif_NbVariables(2) 
     96  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then 
     97     agrif_curgrid%tabvars_r(i)%parent_var%array0 = value 
     98     agrif_curgrid%tabvars_r(i)%parent_var%sarray0 = value 
     99     i_found = .TRUE. 
     100     EXIT 
     101  endif 
     102enddo 
     103 
     104IF (.NOT.i_found) THEN 
     105do i=1,Agrif_NbVariables(2) 
     106  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%sarray0)) then 
     107     agrif_curgrid%tabvars_r(i)%parent_var%array0 = value 
     108     agrif_curgrid%tabvars_r(i)%parent_var%sarray0 = value 
     109     i_found = .TRUE. 
     110     EXIT 
     111  endif 
     112enddo 
     113ENDIF 
     114 
     115if (.NOT.i_found) STOP 'Agrif_Set_parent_real4 : Variable not found' 
     116 
    77117!--------------------------------------------------------------------------------------------------- 
    78118end subroutine Agrif_Set_parent_real4 
    … …  
    82122!  subroutine Agrif_Set_parent_real8 
    83123!--------------------------------------------------------------------------------------------------- 
    84 !> To set the TYPE of the variable 
    85 !--------------------------------------------------------------------------------------------------- 
    86 subroutine Agrif_Set_parent_real8 ( tabvarsindic, value ) 
    87 !--------------------------------------------------------------------------------------------------- 
    88     integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars 
    89     real(kind=8),intent(in) :: value        !< input value 
    90 ! 
    91     Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % darray0 = value 
     124!> To set the parent value of a real variable 
     125!--------------------------------------------------------------------------------------------------- 
     126subroutine Agrif_Set_parent_real8 ( real_variable, value ) 
     127!--------------------------------------------------------------------------------------------------- 
     128    real(kind=8), intent(in)     :: real_variable !< input variable 
     129    real(kind=8),intent(in) :: value        !< input value for the parent grid 
     130 
     131integer :: i 
     132logical :: i_found 
     133 
     134i_found = .FALSE. 
     135 
     136do i=1,Agrif_NbVariables(2) 
     137  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then 
     138     agrif_curgrid%tabvars_r(i)%parent_var%darray0 = value 
     139     agrif_curgrid%tabvars_r(i)%parent_var%array0 = value 
     140     i_found = .TRUE. 
     141     EXIT 
     142  endif 
     143enddo 
     144 
     145IF (.NOT.i_found) THEN 
     146do i=1,Agrif_NbVariables(2) 
     147  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%darray0)) then 
     148     agrif_curgrid%tabvars_r(i)%parent_var%darray0 = value 
     149     agrif_curgrid%tabvars_r(i)%parent_var%array0 = value 
     150     i_found = .TRUE. 
     151     EXIT 
     152  endif 
     153enddo 
     154ENDIF 
     155 
     156if (.NOT.i_found) STOP 'Agrif_Set_parent_real8 : Variable not found' 
     157 
    92158!--------------------------------------------------------------------------------------------------- 
    93159end subroutine Agrif_Set_parent_real8 
    … …  
    106172    type(Agrif_Variable),  pointer  :: var 
    107173! 
    108     indic = Agrif_Curgrid % tabvars_i(tabvarsindic) % iarray0 
    109 ! 
    110     if (indic <= 0) then 
    111         var => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
    112     else 
    113         print*,"Agrif_Set_bc : warning indic >= 0 !!!" 
    114         var => Agrif_Curgrid % tabvars(indic) 
    115     endif 
    116  
     174    var => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic) 
    117175    if (.not.associated(var)) return ! Grand mother grid case 
    118176! 
    … …  
    145203    type(Agrif_Variable), pointer   :: var 
    146204! 
    147     indic = Agrif_Curgrid % tabvars_i(tabvarsindic) % iarray0 
    148 ! 
    149     if (indic <= 0) then 
    150         var => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
    151     else 
    152         print*,"Agrif_Set_interp : warning indic >= 0 !!!" 
    153         var => Agrif_Mygrid % tabvars(indic) 
    154     endif 
     205    var => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic) 
     206    if (.not.associated(var)) return ! Grand mother grid case 
    155207! 
    156208    var % type_interp = Agrif_Constant 
    … …  
    178230    TYPE(Agrif_Variable), pointer   :: var 
    179231! 
    180     indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0 
    181 ! 
    182     if (indic <= 0) then 
    183         var => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
    184     else 
    185         print*,"Agrif_Set_bcinterp : warning indic >= 0 !!!" 
    186         var => Agrif_Mygrid % tabvars(indic) 
    187     endif 
     232    var => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic) 
    188233! 
    189234    var % type_interp_bc = Agrif_Constant 
    … …  
    214259    type(Agrif_Variable),  pointer  :: root_var 
    215260! 
    216     indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0 
    217 ! 
    218     if (indic <= 0) then 
    219         root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
    220     else 
    221         print*,"Agrif_Set_UpdateType : warning indic >= 0 !!!" 
    222         root_var => Agrif_Mygrid % tabvars(indic) 
    223     endif 
     261 
     262        root_var => Agrif_Search_Variable(Agrif_Mygrid,tabvarsindic) 
     263 
    224264! 
    225265    root_var % type_update = Agrif_Update_Copy 
    … …  
    243283    INTEGER :: indic  !  indice of the variable in tabvars 
    244284! 
     285print *,'CURRENTLY BROKEN' 
     286STOP 
     287 
    245288    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0 
    246289! 
    … …  
    283326    type(Agrif_Variable), pointer :: child_var 
    284327    type(Agrif_Variable), pointer :: child_tmp      ! Temporary variable on the child grid 
     328    integer :: i 
     329    integer,dimension(7) :: lb, ub 
    285330! 
    286331    if ( Agrif_Curgrid%level <= 0 ) return 
    287332! 
    288     indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0 
    289333! 
    290334    if ( present(calledweight) ) then 
    … …  
    296340    endif 
    297341! 
    298     if (indic <= 0) then 
    299         child_var  => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     342        child_var  => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic) 
    300343        parent_var => child_var % parent_var 
    301344        root_var   => child_var % root_var 
    302     else 
    303         print*,"Agrif_Bc_variable : warning indic >= 0 !!!" 
    304         child_var  => Agrif_Curgrid % tabvars(indic) 
    305         parent_var => Agrif_Curgrid % parent % tabvars(indic) 
    306         root_var   => Agrif_Mygrid % tabvars(indic) 
    307     endif 
    308345! 
    309346    nbdim = root_var % nbdim 
    310347! 
     348    do i=1,nbdim 
     349      if (root_var%coords(i) == 0) then 
     350        lb(i) = parent_var%lb(i) 
     351        ub(i) = parent_var%ub(i) 
     352      else 
     353        lb(i) = child_var%lb(i) 
     354        ub(i) = child_var%ub(i) 
     355      endif 
     356    enddo 
     357 
    311358    select case( nbdim ) 
    312359    case(1) 
    313         allocate(parray1(child_var%lb(1):child_var%ub(1))) 
     360        allocate(parray1(lb(1):ub(1))) 
    314361    case(2) 
    315         allocate(parray2(child_var%lb(1):child_var%ub(1), & 
    316                          child_var%lb(2):child_var%ub(2) )) 
     362        allocate(parray2(lb(1):ub(1), & 
     363                         lb(2):ub(2) )) 
    317364    case(3) 
    318         allocate(parray3(child_var%lb(1):child_var%ub(1), & 
    319                          child_var%lb(2):child_var%ub(2), & 
    320                          child_var%lb(3):child_var%ub(3) )) 
     365        allocate(parray3(lb(1):ub(1), & 
     366                         lb(2):ub(2), & 
     367                         lb(3):ub(3) )) 
    321368    case(4) 
    322         allocate(parray4(child_var%lb(1):child_var%ub(1), & 
    323                          child_var%lb(2):child_var%ub(2), & 
    324                          child_var%lb(3):child_var%ub(3), & 
    325                          child_var%lb(4):child_var%ub(4) )) 
     369        allocate(parray4(lb(1):ub(1), & 
     370                         lb(2):ub(2), & 
     371                         lb(3):ub(3), & 
     372                         lb(4):ub(4) )) 
    326373    case(5) 
    327         allocate(parray5(child_var%lb(1):child_var%ub(1), & 
    328                          child_var%lb(2):child_var%ub(2), & 
    329                          child_var%lb(3):child_var%ub(3), & 
    330                          child_var%lb(4):child_var%ub(4), & 
    331                          child_var%lb(5):child_var%ub(5) )) 
     374        allocate(parray5(lb(1):ub(1), & 
     375                         lb(2):ub(2), & 
     376                         lb(3):ub(3), & 
     377                         lb(4):ub(4), & 
     378                         lb(5):ub(5) )) 
    332379    case(6) 
    333         allocate(parray6(child_var%lb(1):child_var%ub(1), & 
    334                          child_var%lb(2):child_var%ub(2), & 
    335                          child_var%lb(3):child_var%ub(3), & 
    336                          child_var%lb(4):child_var%ub(4), & 
    337                          child_var%lb(5):child_var%ub(5), & 
    338                          child_var%lb(6):child_var%ub(6) )) 
     380        allocate(parray6(lb(1):ub(1), & 
     381                         lb(2):ub(2), & 
     382                         lb(3):ub(3), & 
     383                         lb(4):ub(4), & 
     384                         lb(5):ub(5), & 
     385                         lb(6):ub(6) )) 
    339386    end select 
    340387! 
    … …  
    343390! 
    344391    child_tmp % root_var => root_var 
     392    child_tmp % parent_var => parent_var 
    345393    child_tmp % oldvalues2D => child_var % oldvalues2D 
    346394! 
    … …  
    400448    type(Agrif_Variable), pointer   :: child_tmp        ! Temporary variable on the child grid 
    401449! 
     450 
    402451    if ( Agrif_Curgrid%level <= 0 ) return 
    403452! 
    404     indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0 
    405 ! 
    406     if (indic <= 0) then 
    407         child_var  => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     453 
     454        child_var  => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic) 
    408455        parent_var => child_var % parent_var 
    409456        root_var   => child_var % root_var 
    410     else 
    411         print*,"Agrif_Interp_variable : warning indic >= 0 !!!" 
    412         child_var  => Agrif_Curgrid % tabvars(indic) 
    413         parent_var => Agrif_Curgrid % parent % tabvars(indic) 
    414         root_var   => Agrif_Mygrid % tabvars(indic) 
    415     endif 
     457 
    416458! 
    417459    nbdim     = root_var % nbdim 
    … …  
    421463! 
    422464    child_tmp % root_var => root_var 
     465    child_tmp % parent_var => parent_var 
    423466    child_tmp % nbdim = root_var % nbdim 
    424467    child_tmp % point = child_var % point 
    … …  
    486529    if (agrif_curgrid%grand_mother_grid) return 
    487530! 
    488     indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0 
    489 ! 
    490     if (indic <= 0) then 
    491         child_var  => Agrif_Search_Variable(Agrif_Curgrid, -indic) 
     531 
     532        child_var  => Agrif_Search_Variable(Agrif_Curgrid, tabvarsindic) 
    492533        parent_var => child_var % parent_var 
    493534 
    494535        if (.not.associated(parent_var)) then 
    495536          ! can occur during the first update of Agrif_Coarsegrid (if any) 
    496           parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, -indic) 
     537          parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, tabvarsindic) 
    497538          child_var % parent_var => parent_var 
    498539        endif 
    499540 
    500541        root_var   => child_var % root_var 
    501     else 
    502         print*,"Agrif_Update_Variable : warning indic >= 0 !!!" 
    503         root_var   => Agrif_Mygrid  % tabvars(indic) 
    504         child_var  => Agrif_Curgrid % tabvars(indic) 
    505         parent_var => Agrif_Curgrid % parent % tabvars(indic) 
    506     endif 
     542 
    507543! 
    508544    nbdim = root_var % nbdim 
    … …  
    551587    integer :: nbdim 
    552588! 
     589print *,'CURRENTLY BROKEN' 
     590STOP 
    553591    root_var => Agrif_Mygrid % tabvars(tabvarsindic0) 
    554592    save_var => Agrif_Curgrid % tabvars(tabvarsindic0) 
    … …  
    575613    integer                         :: indic 
    576614! 
     615print *,'CURRENTLY BROKEN' 
     616STOP 
    577617    indic = tabvarsindic 
    578618    if (tabvarsindic >= 0) then 
    … …  
    612652    integer                         :: indic 
    613653! 
     654print *,'CURRENTLY BROKEN' 
     655STOP 
     656 
    614657    indic = tabvarsindic 
    615658    if (tabvarsindic >= 0) then 
    … …  
    650693    integer                         :: indic 
    651694! 
     695print *,'CURRENTLY BROKEN' 
     696STOP 
    652697    indic = tabvarsindic 
    653698    if (tabvarsindic >= 0) then 
Note: See TracChangeset for help on using the changeset viewer.