- Timestamp:
- 2011-03-08T17:44:21+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F
r2528 r2673 35 35 Use Agrif_Link 36 36 Use Agrif_Arrays 37 Use Agrif_Variables 37 38 C 38 39 IMPLICIT NONE … … 42 43 C 43 44 C 45 Subroutine Agrif_Deallocate_Arrays(Var) 46 type(Agrif_Variable), pointer :: Var 47 48 if (ALLOCATED(var%array1)) then 49 Deallocate(var%array1) 50 endif 51 if (ALLOCATED(var%array2)) then 52 Deallocate(var%array2) 53 endif 54 if (ALLOCATED(var%array3)) then 55 Deallocate(var%array3) 56 endif 57 if (ALLOCATED(var%array4)) then 58 Deallocate(var%array4) 59 endif 60 if (ALLOCATED(var%array5)) then 61 Deallocate(var%array5) 62 endif 63 if (ALLOCATED(var%array6)) then 64 Deallocate(var%array6) 65 endif 66 C 67 if (ALLOCATED(var%darray1)) then 68 Deallocate(var%darray1) 69 endif 70 if (ALLOCATED(var%darray2)) then 71 Deallocate(var%darray2) 72 endif 73 if (ALLOCATED(var%darray3)) then 74 Deallocate(var%darray3) 75 endif 76 if (ALLOCATED(var%darray4)) then 77 Deallocate(var%darray4) 78 endif 79 if (ALLOCATED(var%darray5)) then 80 Deallocate(var%darray5) 81 endif 82 if (ALLOCATED(var%darray6)) then 83 Deallocate(var%darray6) 84 endif 85 C 86 if (ALLOCATED(var%larray1)) then 87 Deallocate(var%larray1) 88 endif 89 if (ALLOCATED(var%larray2)) then 90 Deallocate(var%larray2) 91 endif 92 if (ALLOCATED(var%larray3)) then 93 Deallocate(var%larray3) 94 endif 95 if (ALLOCATED(var%larray4)) then 96 Deallocate(var%larray4) 97 endif 98 if (ALLOCATED(var%larray5)) then 99 Deallocate(var%larray5) 100 endif 101 if (ALLOCATED(var%larray6)) then 102 Deallocate(var%larray6) 103 endif 104 C 105 if (ALLOCATED(var%iarray1)) then 106 Deallocate(var%iarray1) 107 endif 108 if (ALLOCATED(var%iarray2)) then 109 Deallocate(var%iarray2) 110 endif 111 if (ALLOCATED(var%iarray3)) then 112 Deallocate(var%iarray3) 113 endif 114 if (ALLOCATED(var%iarray4)) then 115 Deallocate(var%iarray4) 116 endif 117 if (ALLOCATED(var%iarray5)) then 118 Deallocate(var%iarray5) 119 endif 120 if (ALLOCATED(var%iarray6)) then 121 Deallocate(var%iarray6) 122 endif 123 C 124 if (ALLOCATED(var%carray1)) then 125 Deallocate(var%carray1) 126 endif 127 if (ALLOCATED(var%carray2)) then 128 Deallocate(var%carray2) 129 endif 130 C 131 if (associated(var%oldvalues2D)) then 132 Deallocate(var%oldvalues2D) 133 endif 134 if (associated(var%interpIndex)) then 135 Deallocate(var%interpIndex) 136 endif 137 138 if (associated(var%posvar)) then 139 Deallocate(var%posvar) 140 endif 141 142 if (associated(var%interptab)) then 143 Deallocate(var%interptab) 144 endif 145 146 Return 147 End Subroutine Agrif_Deallocate_Arrays 44 148 C 45 149 C ************************************************************************** … … 62 166 TYPE(Agrif_Grid),pointer :: Agrif_Gr ! Pointer on the current grid 63 167 INTEGER i 168 Type(Agrif_List_Variables), pointer :: parcours 64 169 C 65 170 C … … 67 172 if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then 68 173 C 69 if (associated(Agrif_Gr%tabvars(i)%var%array1)) then 70 Deallocate(Agrif_Gr%tabvars(i)%var%array1) 71 endif 72 if (associated(Agrif_Gr%tabvars(i)%var%array2)) then 73 Deallocate(Agrif_Gr%tabvars(i)%var%array2) 74 endif 75 if (associated(Agrif_Gr%tabvars(i)%var%array3)) then 76 Deallocate(Agrif_Gr%tabvars(i)%var%array3) 77 endif 78 if (associated(Agrif_Gr%tabvars(i)%var%array4)) then 79 Deallocate(Agrif_Gr%tabvars(i)%var%array4) 80 endif 81 if (associated(Agrif_Gr%tabvars(i)%var%array5)) then 82 Deallocate(Agrif_Gr%tabvars(i)%var%array5) 83 endif 84 if (associated(Agrif_Gr%tabvars(i)%var%array6)) then 85 Deallocate(Agrif_Gr%tabvars(i)%var%array6) 86 endif 87 C 88 if (associated(Agrif_Gr%tabvars(i)%var%darray1)) then 89 Deallocate(Agrif_Gr%tabvars(i)%var%darray1) 90 endif 91 if (associated(Agrif_Gr%tabvars(i)%var%darray2)) then 92 Deallocate(Agrif_Gr%tabvars(i)%var%darray2) 93 endif 94 if (associated(Agrif_Gr%tabvars(i)%var%darray3)) then 95 Deallocate(Agrif_Gr%tabvars(i)%var%darray3) 96 endif 97 if (associated(Agrif_Gr%tabvars(i)%var%darray4)) then 98 Deallocate(Agrif_Gr%tabvars(i)%var%darray4) 99 endif 100 if (associated(Agrif_Gr%tabvars(i)%var%darray5)) then 101 Deallocate(Agrif_Gr%tabvars(i)%var%darray5) 102 endif 103 if (associated(Agrif_Gr%tabvars(i)%var%darray6)) then 104 Deallocate(Agrif_Gr%tabvars(i)%var%darray6) 105 endif 106 C 107 if (associated(Agrif_Gr%tabvars(i)%var%larray1)) then 108 Deallocate(Agrif_Gr%tabvars(i)%var%larray1) 109 endif 110 if (associated(Agrif_Gr%tabvars(i)%var%larray2)) then 111 Deallocate(Agrif_Gr%tabvars(i)%var%larray2) 112 endif 113 if (associated(Agrif_Gr%tabvars(i)%var%larray3)) then 114 Deallocate(Agrif_Gr%tabvars(i)%var%larray3) 115 endif 116 if (associated(Agrif_Gr%tabvars(i)%var%larray4)) then 117 Deallocate(Agrif_Gr%tabvars(i)%var%larray4) 118 endif 119 if (associated(Agrif_Gr%tabvars(i)%var%larray5)) then 120 Deallocate(Agrif_Gr%tabvars(i)%var%larray5) 121 endif 122 if (associated(Agrif_Gr%tabvars(i)%var%larray6)) then 123 Deallocate(Agrif_Gr%tabvars(i)%var%larray6) 124 endif 125 C 126 if (associated(Agrif_Gr%tabvars(i)%var%iarray1)) then 127 Deallocate(Agrif_Gr%tabvars(i)%var%iarray1) 128 endif 129 if (associated(Agrif_Gr%tabvars(i)%var%iarray2)) then 130 Deallocate(Agrif_Gr%tabvars(i)%var%iarray2) 131 endif 132 if (associated(Agrif_Gr%tabvars(i)%var%iarray3)) then 133 Deallocate(Agrif_Gr%tabvars(i)%var%iarray3) 134 endif 135 if (associated(Agrif_Gr%tabvars(i)%var%iarray4)) then 136 Deallocate(Agrif_Gr%tabvars(i)%var%iarray4) 137 endif 138 if (associated(Agrif_Gr%tabvars(i)%var%iarray5)) then 139 Deallocate(Agrif_Gr%tabvars(i)%var%iarray5) 140 endif 141 if (associated(Agrif_Gr%tabvars(i)%var%iarray6)) then 142 Deallocate(Agrif_Gr%tabvars(i)%var%iarray6) 143 endif 144 C 145 if (associated(Agrif_Gr%tabvars(i)%var%carray1)) then 146 Deallocate(Agrif_Gr%tabvars(i)%var%carray1) 147 endif 148 if (associated(Agrif_Gr%tabvars(i)%var%carray2)) then 149 Deallocate(Agrif_Gr%tabvars(i)%var%carray2) 150 endif 151 C 152 if (associated(Agrif_Gr%tabvars(i)%var%oldvalues2D)) then 153 Deallocate(Agrif_Gr%tabvars(i)%var%oldvalues2D) 154 endif 155 if (associated(Agrif_Gr%tabvars(i)%var%interpIndex)) then 156 Deallocate(Agrif_Gr%tabvars(i)%var%interpIndex) 157 endif 158 159 if (associated(Agrif_Gr%tabvars(i)%var%posvar)) then 160 Deallocate(Agrif_Gr%tabvars(i)%var%posvar) 161 endif 162 163 if (associated(Agrif_Gr%tabvars(i)%var%interptab)) then 164 Deallocate(Agrif_Gr%tabvars(i)%var%interptab) 165 endif 174 call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var) 166 175 167 176 endif … … 177 186 C 178 187 endif 188 enddo 189 190 parcours => Agrif_Gr%variables 191 192 do i=1,Agrif_Gr%NbVariables 193 if (.NOT. parcours%pvar%var%root_var%restaure) then 194 call Agrif_Deallocate_Arrays(parcours%pvar%var) 195 endif 196 if (associated(parcours%pvar%var%list_interp)) then 197 Call Agrif_Free_list_interp 198 & (parcours%pvar%var%list_interp) 199 endif 200 C 201 if ( .NOT. parcours%pvar%var%root_var % restaure) then 202 Deallocate(parcours%pvar%var) 203 C 204 endif 205 parcours => parcours%nextvariable 179 206 enddo 180 207 C … … 231 258 TYPE(Agrif_Grid),pointer :: Agrif_Gr ! Pointer on the current grid 232 259 INTEGER i 260 Type(Agrif_List_Variables), pointer :: parcours, rootparcours 233 261 C 234 262 C 235 263 do i = 1 , AGRIF_NbVariables 236 264 if ( Agrif_Mygrid % tabvars(i) % var % restaure) then 237 C238 if (associated(Agrif_Gr%tabvars(i)%var%array1)) then239 Deallocate(Agrif_Gr%tabvars(i)%var%array1)240 endif241 if (associated(Agrif_Gr%tabvars(i)%var%array2)) then242 Deallocate(Agrif_Gr%tabvars(i)%var%array2)243 endif244 if (associated(Agrif_Gr%tabvars(i)%var%array3)) then245 Deallocate(Agrif_Gr%tabvars(i)%var%array3)246 endif247 if (associated(Agrif_Gr%tabvars(i)%var%array4)) then248 Deallocate(Agrif_Gr%tabvars(i)%var%array4)249 endif250 if (associated(Agrif_Gr%tabvars(i)%var%array5)) then251 Deallocate(Agrif_Gr%tabvars(i)%var%array5)252 endif253 if (associated(Agrif_Gr%tabvars(i)%var%array6)) then254 Deallocate(Agrif_Gr%tabvars(i)%var%array6)255 endif256 !257 if (associated(Agrif_Gr%tabvars(i)%var%darray1)) then258 Deallocate(Agrif_Gr%tabvars(i)%var%darray1)259 endif260 if (associated(Agrif_Gr%tabvars(i)%var%darray2)) then261 Deallocate(Agrif_Gr%tabvars(i)%var%darray2)262 endif263 if (associated(Agrif_Gr%tabvars(i)%var%darray3)) then264 Deallocate(Agrif_Gr%tabvars(i)%var%darray3)265 endif266 if (associated(Agrif_Gr%tabvars(i)%var%darray4)) then267 Deallocate(Agrif_Gr%tabvars(i)%var%darray4)268 endif269 if (associated(Agrif_Gr%tabvars(i)%var%darray5)) then270 Deallocate(Agrif_Gr%tabvars(i)%var%darray5)271 endif272 if (associated(Agrif_Gr%tabvars(i)%var%darray6)) then273 Deallocate(Agrif_Gr%tabvars(i)%var%darray6)274 endif275 !276 if (associated(Agrif_Gr%tabvars(i)%var%larray1)) then277 Deallocate(Agrif_Gr%tabvars(i)%var%larray1)278 endif279 if (associated(Agrif_Gr%tabvars(i)%var%larray2)) then280 Deallocate(Agrif_Gr%tabvars(i)%var%larray2)281 endif282 if (associated(Agrif_Gr%tabvars(i)%var%larray3)) then283 Deallocate(Agrif_Gr%tabvars(i)%var%larray3)284 endif285 if (associated(Agrif_Gr%tabvars(i)%var%larray4)) then286 Deallocate(Agrif_Gr%tabvars(i)%var%larray4)287 endif288 if (associated(Agrif_Gr%tabvars(i)%var%larray5)) then289 Deallocate(Agrif_Gr%tabvars(i)%var%larray5)290 endif291 if (associated(Agrif_Gr%tabvars(i)%var%larray6)) then292 Deallocate(Agrif_Gr%tabvars(i)%var%larray6)293 endif294 !295 if (associated(Agrif_Gr%tabvars(i)%var%iarray1)) then296 Deallocate(Agrif_Gr%tabvars(i)%var%iarray1)297 endif298 if (associated(Agrif_Gr%tabvars(i)%var%iarray2)) then299 Deallocate(Agrif_Gr%tabvars(i)%var%iarray2)300 endif301 if (associated(Agrif_Gr%tabvars(i)%var%iarray3)) then302 Deallocate(Agrif_Gr%tabvars(i)%var%iarray3)303 endif304 if (associated(Agrif_Gr%tabvars(i)%var%iarray4)) then305 Deallocate(Agrif_Gr%tabvars(i)%var%iarray4)306 endif307 if (associated(Agrif_Gr%tabvars(i)%var%iarray5)) then308 Deallocate(Agrif_Gr%tabvars(i)%var%iarray5)309 endif310 if (associated(Agrif_Gr%tabvars(i)%var%iarray6)) then311 Deallocate(Agrif_Gr%tabvars(i)%var%iarray6)312 endif313 !314 if (associated(Agrif_Gr%tabvars(i)%var%carray1)) then315 Deallocate(Agrif_Gr%tabvars(i)%var%carray1)316 endif317 if (associated(Agrif_Gr%tabvars(i)%var%carray2)) then318 Deallocate(Agrif_Gr%tabvars(i)%var%carray2)319 endif320 !321 if (associated(Agrif_Gr%tabvars(i)%var%oldvalues2D)) then322 Deallocate(Agrif_Gr%tabvars(i)%var%oldvalues2D)323 endif324 if (associated(Agrif_Gr%tabvars(i)%var%interpIndex)) then325 Deallocate(Agrif_Gr%tabvars(i)%var%interpIndex)326 endif327 265 328 if (associated(Agrif_Gr%tabvars(i)%var%posvar)) then 329 Deallocate(Agrif_Gr%tabvars(i)%var%posvar) 330 endif 331 332 if (associated(Agrif_Gr%tabvars(i)%var%interptab)) then 333 Deallocate(Agrif_Gr%tabvars(i)%var%interptab) 334 endif 335 ! 266 call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var) 267 ! 336 268 Deallocate(Agrif_Gr%tabvars(i)%var) 337 269 ! 338 270 endif 339 271 enddo 272 273 parcours => Agrif_Gr%variables 274 rootparcours=>Agrif_Mygrid%variables 275 276 do i=1,Agrif_Gr%NbVariables 277 if (rootparcours%pvar%var%restaure) then 278 call Agrif_Deallocate_Arrays(parcours%pvar%var) 279 280 Deallocate(parcours%pvar%var) 281 C 282 endif 283 parcours => parcours%nextvariable 284 rootparcours => rootparcours%nextvariable 285 enddo 286 340 287 C 341 288 C … … 464 411 C 465 412 End Subroutine Agrif_CopyFromold 413 414 CC ************************************************************************** 415 CCC Subroutine AGRIF_CopyFromold_AllOneVar 416 C ************************************************************************** 417 C 418 Recursive Subroutine AGRIF_CopyFromold_AllOneVar(g,oldchildgrids, 419 & indic) 420 C 421 CCC Description: 422 CCC Routine called in the Agrif_Init_Hierarchy procedure 423 C (Agrif_Clustering module). 424 C 425 CC Method: 426 C 427 C Declarations: 428 C 429 430 C 431 C Pointer argument 432 TYPE(AGRIF_grid),pointer :: g ! Pointer on the current grid 433 TYPE(AGRIF_pgrid),pointer :: oldchildgrids 434 integer :: indic 435 C 436 C Local pointer 437 TYPE(AGRIF_pgrid),pointer :: parcours ! Pointer for the recursive 438 ! procedure 439 REAL g_eps,eps,oldgrid_eps 440 INTEGER :: out 441 INTEGER :: iii 442 C 443 out = 0 444 C 445 parcours => oldchildgrids 446 C 447 do while (associated(parcours)) 448 C 449 if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then 450 C 451 g_eps = huge(1.) 452 oldgrid_eps = huge(1.) 453 do iii = 1 , Agrif_Probdim 454 g_eps = min(g_eps,g % Agrif_d(iii)) 455 oldgrid_eps = min(oldgrid_eps, 456 & parcours % gr % Agrif_d(iii)) 457 enddo 458 C 459 eps = min(g_eps,oldgrid_eps)/100. 460 C 461 do iii = 1 , Agrif_Probdim 462 463 if (g % Agrif_d(iii) .LT. 464 & (parcours % gr % Agrif_d(iii) - eps)) then 465 C 466 parcours => parcours % next 467 C 468 out = 1 469 C 470 Exit 471 C 472 endif 473 C 474 enddo 475 if ( out .EQ. 1 ) Cycle 476 C 477 Call AGRIF_CopyFromOldOneVar(g,parcours%gr,indic) 478 C 479 endif 480 C 481 Call Agrif_CopyFromold_AllOneVar 482 & (g, parcours % gr % child_grids,indic) 483 C 484 parcours => parcours % next 485 C 486 enddo 487 C 488 C 489 Return 490 C 491 C 492 End Subroutine AGRIF_CopyFromold_AllOneVar 493 C 494 C 495 C 496 C ************************************************************************** 497 CCC Subroutine Agrif_CopyFromoldOneVar 498 C ************************************************************************** 499 C 500 Subroutine Agrif_CopyFromoldOneVar(Agrif_New_Gr,Agrif_Old_Gr, 501 & indic) 502 C 503 CCC Description: 504 CCC Call to the Agrif_Copy procedure. 505 C 506 CC Method: 507 CC 508 C 509 C Declarations: 510 C 511 512 C 513 C Pointer argument 514 TYPE(Agrif_Grid),Pointer :: Agrif_New_Gr ! Pointer on the current grid 515 TYPE(Agrif_Grid),Pointer :: Agrif_Old_Gr ! Pointer on an old grid 516 INTEGER :: indic 517 INTEGER :: i 518 TYPE(Agrif_PVariable),Pointer ::tabvars,oldtabvars 519 C 520 C 521 tabvars => Agrif_Search_Variable(Agrif_New_Gr,-indic) 522 oldtabvars => Agrif_Search_Variable(Agrif_Old_Gr,-indic) 523 524 Call Agrif_Nbdim_Allocation(tabvars%var, 525 & tabvars%var%lb,tabvars%var%ub, 526 & tabvars%var%nbdim) 527 528 Call Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr, 529 & tabvars,oldtabvars) 530 531 532 C 533 C 534 Return 535 C 536 C 537 End Subroutine Agrif_CopyFromoldOneVar 538 466 539 C 467 540 C … … 753 826 enddo 754 827 CASE (2) 828 755 829 i0 = ind_gmin(1) 756 830 do i = ind_newmin(1),ind_newmax(1)
Note: See TracChangeset
for help on using the changeset viewer.