/[MITgcm]/MITgcm_contrib/heimbach/OpenAD/code_shallow_openad/ad_template.sa_cg2d.f
ViewVC logotype

Annotation of /MITgcm_contrib/heimbach/OpenAD/code_shallow_openad/ad_template.sa_cg2d.f

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (hide annotations) (download)
Wed Jan 11 06:30:20 2006 UTC (20 years, 10 months ago) by utke
Branch: MAIN
template for selfadjoint cg2d

1 utke 1.1 subroutine template()
2     use OpenAD_tape
3     use OpenAD_rev
4    
5     !$TEMPLATE_PRAGMA_DECLARATIONS
6    
7     integer :: cp_loop_variable_1,cp_loop_variable_2,
8     + cp_loop_variable_3,cp_loop_variable_4
9    
10     type(modeType) :: our_orig_mode
11    
12     integer iaddr
13     external iaddr
14    
15     character*(80):: indentation='
16     + '
17     our_indent=our_indent+1
18     c write(*,'(A,A,A,A,L,A,L,A,L,A,L,A,L,A,L)')
19     c +'JU:',indentation(1:our_indent), "enter __SRNAME__:",
20     c +' As:',our_rev_mode%arg_store,
21     c +' Ar:',our_rev_mode%arg_restore,
22     c +' Pl:',our_rev_mode%plain,
23     c +' Ta:',our_rev_mode%tape,
24     c +' Ad:',our_rev_mode%adjoint,
25     c +' Sw:',our_rev_mode%switchedToCheckpoint
26     c$$$
27     c$$$ write(*,'(A,A,A,I8,A,I8)')
28     c$$$ + indentation(1:our_indent), "enter __SRNAME__:",
29     c$$$ + " DT:",double_tape_pointer,
30     c$$$ + " IT:",integer_tape_pointer
31    
32    
33     if (our_rev_mode%plain .OR. our_rev_mode%tape) then
34     write(*,'(A,A,A)')
35     +'JU:',indentation(1:our_indent),
36     +' __SRNAME__: entering plain or tape'
37     !$PLACEHOLDER_PRAGMA$ id=1
38     end if
39     if (our_rev_mode%adjoint) then
40     write(*,'(A,A,A)')
41     +'JU:',indentation(1:our_indent),
42     +' __SRNAME__: entering adjoint'
43     c selfadjoint
44     c assign the adjoints to the values
45     c and permute the arguments
46     do cp_loop_variable_1=1-OLx,sNx+OLx
47     do cp_loop_variable_2=1-OLy,sNy+OLy
48     do cp_loop_variable_3=1,nSx
49     do cp_loop_variable_4=1,nSy
50     cg2d_b%v=cg2d_x%d
51     cg2d_x%v=cg2d_b%d
52     end do
53     end do
54     end do
55     end do
56     c set up for plain execution
57     our_orig_mode=our_rev_mode
58     our_rev_mode%arg_store=.FALSE.
59     our_rev_mode%arg_restore=.FALSE.
60     our_rev_mode%plain=.TRUE.
61     our_rev_mode%tape=.FALSE.
62     our_rev_mode%adjoint=.FALSE.
63     !$PLACEHOLDER_PRAGMA$ id=1
64     c reset the mode
65     our_rev_mode=our_orig_mode
66     c copy the results back to the adjoints
67     do cp_loop_variable_1=1-OLx,sNx+OLx
68     do cp_loop_variable_2=1-OLy,sNy+OLy
69     do cp_loop_variable_3=1,nSx
70     do cp_loop_variable_4=1,nSy
71     cg2d_b%d=cg2d_x%v
72     cg2d_x%d=cg2d_b%v
73     end do
74     end do
75     end do
76     end do
77     end if
78    
79     c$$$ write(*,'(A,A,A,I8,A,I8)')
80     c$$$ + indentation(1:our_indent), "leave __SRNAME__:",
81     c$$$ + " DT:",double_tape_pointer,
82     c$$$ + " IT:",integer_tape_pointer
83     c$$$
84     c write(*,'(A,A,A,A,L,A,L,A,L,A,L,A,L,A,L)')
85     c +'JU:',indentation(1:our_indent), "leave __SRNAME__:",
86     c +' As:',our_rev_mode%arg_store,
87     c +' Ar:',our_rev_mode%arg_restore,
88     c +' Pl:',our_rev_mode%plain,
89     c +' Ta:',our_rev_mode%tape,
90     c +' Ad:',our_rev_mode%adjoint,
91     c +' Sw:',our_rev_mode%switchedToCheckpoint
92     our_indent=our_indent-1
93     end subroutine template

  ViewVC Help
Powered by ViewVC 1.1.22