libsim  Versione7.2.6
modqc_peeling_include.F90
1 ! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2 ! authors:
3 ! Davide Cesari <dcesari@arpa.emr.it>
4 ! Paolo Patruno <ppatruno@arpa.emr.it>
5 
6 ! This program is free software; you can redistribute it and/or
7 ! modify it under the terms of the GNU General Public License as
8 ! published by the Free Software Foundation; either version 2 of
9 ! the License, or (at your option) any later version.
10 
11 ! This program is distributed in the hope that it will be useful,
12 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ! GNU General Public License for more details.
15 
16 ! You should have received a copy of the GNU General Public License
17 ! along with this program. If not, see <http://www.gnu.org/licenses/>.
18 
19 
20 
21 
22 if (associated(this%datiattr%/**/vol7d_poly_types)) then
23  inddatiattrinv = firsttrue(attrvars%vars(1) == this%datiattr%/**/vol7d_poly_types) !indice attributo
24  inddatiattrcli = firsttrue(attrvars%vars(2) == this%datiattr%/**/vol7d_poly_types) !indice attributo
25  inddatiattrtem = firsttrue(attrvars%vars(3) == this%datiattr%/**/vol7d_poly_types) !indice attributo
26  inddatiattrspa = firsttrue(attrvars%vars(4) == this%datiattr%/**/vol7d_poly_types) !indice attributo
27 
28  if (inddatiattrinv > 0 .or. inddatiattrcli > 0 .or. inddatiattrtem > 0 .or. inddatiattrspa > 0 ) then ! solo se c'รจ l'attributo
29 
30  if (associated(this%dativarattr%/**/vol7d_poly_types)) then
31  !print *, "ELABORO this%dativarattr%&
32  ! & VOL7D_POLY_TYPES &
33  ! &",inddatiattrinv, inddatiattrcli, inddatiattrtem, inddatiattrspa
34  !print *, "dimensione dativarattr",size(this%dativarattr%/**/VOL7D_POLY_TYPES)
35 
36  if (associated(this%dativar%/**/vol7d_poly_subtypes)) then
37  !print *, "ELABORO this%dativar%&
38  ! & VOL7D_POLY_SUBTYPES &
39  ! &"
40  !print *, "dimensione dativar ",size(this%dativar%/**/VOL7D_POLY_SUBTYPES)
41 
42  do inddativar=1,size(this%dativar%/**/vol7d_poly_subtypes) ! per tutte le variabili /**/VOL7D_POLY_SUBTYPES
43 
44  inddativarattr = this%dativar%/**/vol7d_poly_subtypes(inddativar)%/**/vol7d_poly_types
45  !call display (this%dativar%/**/VOL7D_POLY_SUBTYPES(inddativar))
46  !print *, "this%dativar%"//' #VOL7D_POLY_SUBTYPES ',inddativarattr
47 
48  if (inddativarattr > 0) then ! se la variabile ha quell'attributo /**/VOL7D_POLY_TYPES
49  nullify(invb/**/vol7d_poly_types)
50  nullify(clib/**/vol7d_poly_types)
51  nullify(temb/**/vol7d_poly_types)
52  nullify(spab/**/vol7d_poly_types)
53 
54  if (inddatiattrinv > 0) invb/**/vol7d_poly_types => this%voldatiattr/**/vol7d_poly_types(:,:,:,:,inddativarattr,:,inddatiattrinv)
55  if (inddatiattrcli > 0) clib/**/vol7d_poly_types => this%voldatiattr/**/vol7d_poly_types(:,:,:,:,inddativarattr,:,inddatiattrcli)
56  if (inddatiattrtem > 0) temb/**/vol7d_poly_types => this%voldatiattr/**/vol7d_poly_types(:,:,:,:,inddativarattr,:,inddatiattrtem)
57  if (inddatiattrspa > 0) spab/**/vol7d_poly_types => this%voldatiattr/**/vol7d_poly_types(:,:,:,:,inddativarattr,:,inddatiattrspa)
58 
59  this%voldati/**/vol7d_poly_subtypes(:,:,:,:,inddativar,:) = peeled(this%voldati/**/vol7d_poly_subtypes(:,:,:,:,inddativar,:), &
60  invb/**/vol7d_poly_types,clib/**/vol7d_poly_types,temb/**/vol7d_poly_types,spab/**/vol7d_poly_types)
61  end if
62  end do
63  endif
64  endif
65  end if
66 end if

Generated with Doxygen.